------------------------------------------------------------------------------
--                                                                          --
--                            GNATPP COMPONENTS                             --
--                                                                          --
--                     G N A T P P . P P _ O U T P U T                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2001-2013, 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)                 --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2012;

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

with Asis.Text;                       use Asis.Text;

with ASIS_UL.Output;                  use ASIS_UL.Output;

with GNATPP.Comments;                 use GNATPP.Comments;
with GNATPP.Options;                  use GNATPP.Options;
with GNATPP.Source_Line_Buffer;       use GNATPP.Source_Line_Buffer;
with GNATPP.State;                    use GNATPP.State;
with GNATPP.Paragraphs;               use GNATPP.Paragraphs;

package body GNATPP.PP_Output is

   Last_Char_Was_Space : Boolean := False;

   -------------------------
   -- Available_In_Output --
   -------------------------

   function Available_In_Output return Integer is
      Result : Integer := Max_Line_Length - Output_Pos + 1;
   begin
      if Postponed_Space then
         Result := Result - 1;
      end if;

      return Result;
   end Available_In_Output;

   --------------------
   -- Get_Output_Pos --
   --------------------

   function Get_Output_Pos return Integer is
      Result : Integer := Output_Pos;
   begin

      if Postponed_Space then
         Result := Result + 1;
      end if;

      return Result;
   end Get_Output_Pos;

   -------------------
   -- PP_Close_Line --
   -------------------

   procedure PP_Close_Line is
   begin

      if The_Very_First_Line then
         The_Very_First_Line := False;
      end if;

      New_Line;

      Current_Out_Line    := Current_Out_Line + 1;
      Is_New_Output_Line  := True;
      Output_Pos          := 1;
      Output_Line         := Output_Line + 1;
      Last_Char_Was_Space := False;
   end PP_Close_Line;

   ----------------------
   -- PP_Continue_Line --
   ----------------------

   procedure PP_Continue_Line
     (Adjust_New_Line_Depth : Integer := 0;
      No_Space              : Boolean := False)
   is
   begin
      Saved_Last_KW  := Last_KW;
      Saved_Last_Dlm := Last_Dlm;

      if Is_New_Output_Line then

         PP_New_Continuation_Line (Adjust_New_Line_Depth);
         Last_Char_Was_Space := True;

      elsif not Last_Char_Was_Space and then
            Output_Pos < Max_Line_Length
      then

         if not No_Space then
            PP_Word_No_Move (" ");
            Last_Char_Was_Space := True;
         end if;

         Postponed_Space := False;
      end if;

      Last_KW  := Saved_Last_KW;
      Last_Dlm := Saved_Last_Dlm;
   end PP_Continue_Line;

   --------------------------------
   -- PP_Continue_Line_Postponed --
   --------------------------------

   procedure PP_Continue_Line_Postponed
     (Adjust_New_Line_Depth : Integer := 0)
   is
   begin
      Saved_Last_KW  := Last_KW;
      Saved_Last_Dlm := Last_Dlm;

      if Is_New_Output_Line then
         PP_New_Line
           (Adjust_Depth => Adjust_New_Line_Depth + 1,
            Backspace    => 1);
         Last_Char_Was_Space := True;

      elsif not Last_Char_Was_Space and then
            Output_Pos < Max_Line_Length
      then
         Postponed_Space := True;
      end if;

      Last_KW  := Saved_Last_KW;
      Last_Dlm := Saved_Last_Dlm;
   end PP_Continue_Line_Postponed;

   ------------------
   -- PP_Delimiter --
   ------------------

   procedure PP_Delimiter (DL : Delimiter_Kinds) is
   begin

      case DL is
         when Not_A_Dlm               => null;
         when Ampersand_Dlm           => PP_Word ("&");
         when Tick_Dlm                => PP_Word ("'");
         when Left_Parenthesis_Dlm    => PP_Word ("(");
         when Right_Parenthesis_Dlm   => PP_Word (")");
         when Asterisk_Dlm            => PP_Word ("*");
         when Plus_Dlm                => PP_Word ("+");
         when Comma_Dlm               => PP_Word (",");
         when Minus_Dlm               => PP_Word ("-");
         when Dot_Dlm                 => PP_Word (".");
         when Divide_Dlm              => PP_Word ("/");
         when Colon_Dlm               => PP_Word (":");
         when Semicolon_Dlm           => PP_Word (";");
         when Less_Than_Dlm           => PP_Word ("<");
         when Equals_Dlm              => PP_Word ("=");
         when Greater_Than_Dlm        => PP_Word (">");
         when Vertical_Line_Dlm       => PP_Word ("|");
         when Exclamation_Mark_Dlm    => PP_Word ("!");
         when Arrow_Dlm               => PP_Word ("=>");
         when Double_Dot_Dlm          => PP_Word ("..");
         when Double_Star_Dlm         => PP_Word ("**");
         when Assignment_Dlm          => PP_Word (":=");
         when Inequality_Dlm          => PP_Word ("/=");
         when Greater_Or_Equal_Dlm    => PP_Word (">=");
         when Less_Or_Equal_Dlm       => PP_Word ("<=");
         when Left_Label_Bracket_Dlm  => PP_Word ("<<");
         when Right_Label_Bracket_Dlm => PP_Word (">>");
         when Box_Dlm                 => PP_Word ("<>");
      end case;

      Last_KW  := Not_A_KW;
      Last_Dlm := DL;

      if DL /= Not_A_Dlm then
         Last_Char_Was_Space := False;
      end if;

   end PP_Delimiter;

   ----------------
   -- PP_Keyword --
   ----------------

   procedure PP_Keyword (KW : Keyword_Kinds) is
      function Adjust_KW_Case (Str : Program_Text) return Program_Text;
      --  Converts the keyword casing according to the gnatpp settings

      function Adjust_KW_Case (Str : Program_Text) return Program_Text is
         Result : Program_Text := Str;
      begin

         if GNATPP.Options.PP_Keyword_Casing = Upper_Case then
            Result := To_Wide_String (To_Upper (To_String (Result)));
         end if;

         return Result;

      end Adjust_KW_Case;

   begin

      case KW is

         when Not_A_KW     => null;
         when KW_Abort     => PP_Word (Adjust_KW_Case (Abort_String));
         when KW_Abs       => PP_Word (Adjust_KW_Case (Abs_String));
         when KW_Abstract  => PP_Word (Adjust_KW_Case (Abstract_String));
         when KW_Accept    => PP_Word (Adjust_KW_Case (Accept_String));
         when KW_Access    => PP_Word (Adjust_KW_Case (Access_String));
         when KW_Aliased   => PP_Word (Adjust_KW_Case (Aliased_String));
         when KW_All       => PP_Word (Adjust_KW_Case (All_String));
         when KW_And       => PP_Word (Adjust_KW_Case (And_String));
         when KW_Array     => PP_Word (Adjust_KW_Case (Array_String));
         when KW_At        => PP_Word (Adjust_KW_Case (At_String));

         when KW_Begin     =>
            PP_Word (Adjust_KW_Case (Begin_String));
            Set_No_Paragraph;

         when KW_Body      => PP_Word (Adjust_KW_Case (Body_String));
         when KW_Case      => PP_Word (Adjust_KW_Case (Case_String));
         when KW_Constant  => PP_Word (Adjust_KW_Case (Constant_String));
         when KW_Declare   => PP_Word (Adjust_KW_Case (Declare_String));
         when KW_Delay     => PP_Word (Adjust_KW_Case (Delay_String));
         when KW_Delta     => PP_Word (Adjust_KW_Case (Delta_String));
         when KW_Digits    => PP_Word (Adjust_KW_Case (Digits_String));
         when KW_Do        => PP_Word (Adjust_KW_Case (Do_String));
         when KW_Else      => PP_Word (Adjust_KW_Case (Else_String));

         when KW_Elsif     =>
            PP_Word (Adjust_KW_Case (Elsif_String));
            Last_If_Path_Start := Current_Out_Line;

         when KW_End       => PP_Word (Adjust_KW_Case (End_String));
         when KW_Entry     => PP_Word (Adjust_KW_Case (Entry_String));
         when KW_Exception => PP_Word (Adjust_KW_Case (Exception_String));
         when KW_Exit      => PP_Word (Adjust_KW_Case (Exit_String));

         when KW_For       =>
            PP_Word (Adjust_KW_Case (For_String));
            Last_Loop_Start := Current_Out_Line;

         when KW_Function  => PP_Word (Adjust_KW_Case (Function_String));
         when KW_Generic   => PP_Word (Adjust_KW_Case (Generic_String));
         when KW_Goto      => PP_Word (Adjust_KW_Case (Goto_String));

         when KW_If        =>
            PP_Word (Adjust_KW_Case (If_String));
            Last_If_Path_Start := Current_Out_Line;

         when KW_In        => PP_Word (Adjust_KW_Case (In_String));
         when KW_Is        => PP_Word (Adjust_KW_Case (KW_Is_String));
         when KW_Limited   => PP_Word (Adjust_KW_Case (Limited_String));
         when KW_Loop      => PP_Word (Adjust_KW_Case (Loop_String));
         when KW_Mod       => PP_Word (Adjust_KW_Case (Mod_String));
         when KW_New       => PP_Word (Adjust_KW_Case (New_String));
         when KW_Not       => PP_Word (Adjust_KW_Case (Not_String));
         when KW_Null      => PP_Word (Adjust_KW_Case (Null_String));
         when KW_Of        => PP_Word (Adjust_KW_Case (Of_String));
         when KW_Or        => PP_Word (Adjust_KW_Case (Or_String));
         when KW_Others    => PP_Word (Adjust_KW_Case (Others_String));
         when KW_Out       => PP_Word (Adjust_KW_Case (Out_String));
         when KW_Package   => PP_Word (Adjust_KW_Case (Package_String));
         when KW_Pragma    => PP_Word (Adjust_KW_Case (Pragma_String));

         when KW_Private   =>
            PP_Word (Adjust_KW_Case (Private_String));
            Set_No_Paragraph;

         when KW_Procedure => PP_Word (Adjust_KW_Case (Procedure_String));
         when KW_Protected => PP_Word (Adjust_KW_Case (Protected_String));
         when KW_Raise     => PP_Word (Adjust_KW_Case (Raise_String));
         when KW_Range     => PP_Word (Adjust_KW_Case (Range_String));
         when KW_Record    => PP_Word (Adjust_KW_Case (Record_String));
         when KW_Rem       => PP_Word (Adjust_KW_Case (Rem_String));
         when KW_Renames   => PP_Word (Adjust_KW_Case (Renames_String));
         when KW_Requeue   => PP_Word (Adjust_KW_Case (Requeue_String));
         when KW_Return    => PP_Word (Adjust_KW_Case (Return_String));
         when KW_Reverse   => PP_Word (Adjust_KW_Case (Reverse_String));
         when KW_Select    => PP_Word (Adjust_KW_Case (Select_String));
         when KW_Separate  => PP_Word (Adjust_KW_Case (Separate_String));
         when KW_Subtype   => PP_Word (Adjust_KW_Case (Subtype_String));
         when KW_Tagged    => PP_Word (Adjust_KW_Case (Tagged_String));
         when KW_Task      => PP_Word (Adjust_KW_Case (Task_String));
         when KW_Terminate => PP_Word (Adjust_KW_Case (Terminate_String));
         when KW_Then      => PP_Word (Adjust_KW_Case (Then_String));

         when KW_Type      =>
            PP_Word (Adjust_KW_Case (Type_String));
            Last_Type_Start := Current_Out_Line;

         when KW_Until     => PP_Word (Adjust_KW_Case (Until_String));
         when KW_Use       => PP_Word (Adjust_KW_Case (Use_String));
         when KW_When      => PP_Word (Adjust_KW_Case (When_String));

         when KW_While     =>
            PP_Word (Adjust_KW_Case (While_String));
            Last_Loop_Start := Current_Out_Line;

         when KW_With      => PP_Word (Adjust_KW_Case (With_String));
         when KW_Xor       => PP_Word (Adjust_KW_Case (Xor_String));

         --  Ada 2005 keywords:
         when KW_Interface    => PP_Word (Adjust_KW_Case (Interface_String));
         when KW_Overriding   => PP_Word (Adjust_KW_Case (Overriding_String));
         when KW_Synchronized =>
            PP_Word (Adjust_KW_Case (Synchronized_String));

         --  Ada 2012 keywords:
         when KW_Some =>
            PP_Word (Adjust_KW_Case (Some_String));
      end case;

      Last_KW  := KW;
      Last_Dlm := Not_A_Dlm;

      if KW /= Not_A_KW then
         Last_Char_Was_Space := False;
      end if;

   end PP_Keyword;

   ------------------------------
   -- PP_New_Continuation_Line --
   ------------------------------

   procedure PP_New_Continuation_Line (Adjust_New_Line_Depth : Integer := 0) is
   begin
      if not Is_New_Output_Line or else
         Output_Pos = 1
      then
         PP_New_Line (Adjust_Depth => Adjust_New_Line_Depth);
         PP_Pad (PP_Cont_Line_Indentation + 1);
         Last_Char_Was_Space := True;
         Postponed_Space := False;
      end if;
   end PP_New_Continuation_Line;

   -----------------
   -- PP_New_Line --
   -----------------

   procedure PP_New_Line
     (Adjust_Depth : Integer := 0;
      Backspace    : Natural := 0)
   is
      Actual_Indent : Natural;
   begin

      if The_Very_First_Line then
         The_Very_First_Line := False;
         return;
      end if;

      if not Is_New_Output_Line then
         PP_Close_Line;
         Last_Char_Was_Space := False;
      end if;

      Output_Pos := Integer (Col);

      if Output_Pos = 1 then
         Actual_Indent :=
           (Logical_Depth + Adjust_Depth) * PP_Indentation - Backspace;

         for J in 1 .. Actual_Indent loop
            PP_Space;
         end loop;

         if Actual_Indent > 0 then
            Last_Char_Was_Space := True;
         end if;

      end if;

      Postponed_Space := False;
   end PP_New_Line;

   -------------------------
   -- PP_New_Line_And_Pad --
   -------------------------

   procedure PP_New_Line_And_Pad (Up_To : Natural := 0) is
   begin

      Last_Char_Was_Space := False;

      if The_Very_First_Line then
         The_Very_First_Line := False;
         return;
      end if;

      if not Is_New_Output_Line then
         PP_Close_Line;
      end if;

      if Output_Pos = 1 then
         PP_Pad (Up_To);
      end if;

   end PP_New_Line_And_Pad;

   -------------------------------
   -- PP_New_Line_For_Index_Def --
   -------------------------------

   procedure PP_New_Line_For_Index_Def is
      Up_To : constant Natural := (Logical_Depth + 1) * PP_Indentation + 6 + 1;
   begin
      PP_New_Line_And_Pad (Up_To);
   end PP_New_Line_For_Index_Def;

   -----------------
   -- PP_Operator --
   -----------------

   procedure PP_Operator (Op : Flat_Element_Kinds) is
   begin
      Last_KW  := Not_A_KW;
      Last_Dlm := Not_A_Dlm;

      case Op is
         when A_Concatenate_Operator =>
            PP_Word ("&");
            Last_Dlm := Ampersand_Dlm;

         when A_Multiply_Operator =>
            PP_Word ("*");
            Last_Dlm := Asterisk_Dlm;

         when A_Unary_Plus_Operator |
              A_Plus_Operator       =>
            PP_Word ("+");
            Last_Dlm := Plus_Dlm;

         when A_Unary_Minus_Operator |
              A_Minus_Operator       =>
            PP_Word ("-");
            Last_Dlm := Minus_Dlm;

         when A_Divide_Operator =>
            PP_Word ("/");
            Last_Dlm := Divide_Dlm;

         when A_Less_Than_Operator =>
            PP_Word ("<");
            Last_Dlm := Less_Than_Dlm;

         when An_Equal_Operator =>
            PP_Word ("=");
            Last_Dlm := Equals_Dlm;

         when A_Greater_Than_Operator =>
            PP_Word (">");
            Last_Dlm := Greater_Than_Dlm;

         when An_Exponentiate_Operator =>
            PP_Word ("**");
            Last_Dlm := Double_Star_Dlm;

         when A_Not_Equal_Operator =>
            PP_Word ("/=");
            Last_Dlm := Inequality_Dlm;

         when A_Greater_Than_Or_Equal_Operator =>
            PP_Word (">=");
            Last_Dlm := Greater_Or_Equal_Dlm;

         when A_Less_Than_Or_Equal_Operator =>
            PP_Word ("<=");
            Last_Dlm := Less_Or_Equal_Dlm;

         when An_And_Operator =>
            PP_Keyword (KW_And);

         when An_Or_Operator =>
            PP_Keyword (KW_Or);

         when An_Xor_Operator =>
            PP_Keyword (KW_Xor);

         when A_Mod_Operator =>
            PP_Keyword (KW_Mod);

         when A_Rem_Operator =>
            PP_Keyword (KW_Rem);

         when An_Abs_Operator =>
            PP_Keyword (KW_Abs);

         when A_Not_Operator =>
            PP_Keyword (KW_Not);

         when others =>
            null;
      end case;

      if Op = A_Unary_Minus_Operator or else
         Op = A_Unary_Plus_Operator
      then
         Unary_Adding_Op_Just_Printed := True;
      else
         Unary_Adding_Op_Just_Printed := False;
      end if;

      Last_Char_Was_Space := False;

   end PP_Operator;

   ------------
   -- PP_Pad --
   ------------

   procedure PP_Pad (N : Natural) is
   begin

      if N = 0 then
         return;
      end if;

      Postponed_Space := False;

      for J in 1 .. N - 1 loop
         Put (" ");
      end loop;

      Output_Pos := Output_Pos + N - 1;

      if N > 1 then
         Last_Char_Was_Space := True;
      end if;

   end PP_Pad;

   ------------------
   -- PP_Pad_Up_To --
   ------------------

   procedure PP_Pad_Up_To (N : Natural) is
   begin

      if N >= Output_Pos then
         PP_Pad (N - Output_Pos + 1);
         Last_Char_Was_Space := True;
      end if;

   end PP_Pad_Up_To;

   ------------------------
   -- PP_Postponed_Space --
   ------------------------

   procedure PP_Postponed_Space is
   begin

      if Postponed_Space and then
         not Last_Char_Was_Space
      then
         PP_Space;
         Postponed_Space := False;
      end if;

   end PP_Postponed_Space;

   --------------
   -- PP_Space --
   --------------

   procedure PP_Space is
   begin

      if Output_Pos < Max_Line_Length then
         Put (" ");
         Output_Pos := Output_Pos + 1;
         Last_Char_Was_Space := True;
      end if;

   end PP_Space;

   ------------------------
   -- PP_Space_If_Needed --
   ------------------------

   procedure PP_Space_If_Needed is
   begin

      if not Last_Char_Was_Space then
         PP_Space;
      end if;

   end PP_Space_If_Needed;

   -------------
   -- PP_Word --
   -------------

   procedure PP_Word (S : Program_Text) is
   begin
      PP_Word_No_Move (S);

      Line_Pos := Line_Pos + S'Length;

      if Line_Pos > Line_Len then
         Line_Pos := 0;
      end if;

      Last_KW  := Not_A_KW;
      Last_Dlm := Not_A_Dlm;

   end PP_Word;

   ---------------------
   -- PP_Word_No_Move --
   ---------------------

   procedure PP_Word_No_Move (S : Program_Text) is
   begin

      if S'Length > Available_In_Output then
         SLOC_Warning
           (Message => "the line is too long",
            SLOC    => Get_Current_SLOC);

         if not Is_New_Output_Line then
            PP_Close_Line;
         end if;

      end if;

      Put (S);
      Output_Pos := Output_Pos + S'Length;
      Is_New_Output_Line := False;

      Last_KW  := Not_A_KW;
      Last_Dlm := Not_A_Dlm;

      Last_Char_Was_Space := False;
   end PP_Word_No_Move;

   -----------------
   -- Print_As_Is --
   -----------------

   procedure Print_As_Is (E : Asis.Element) is
      HT : constant Wide_Character := To_Wide_Character (ASCII.HT);
      Lines_To_Print : constant Line_List := Lines (E);
   begin
      for J in Lines_To_Print'Range loop
         declare
            Line : constant Program_Text := Line_Image (Lines_To_Print (J));
            First : Natural := Line'First;
         begin
            --  Remove leading blanks from the first line, and adjust Line_Pos
            --  accordingly

            if J = Lines_To_Print'First then
               while First <= Line'Last and then
                 (Line (First) = ' ' or else Line (First) = HT)
               loop
                  First := First + 1;
                  Line_Pos := Line_Pos + 1;
               end loop;
            end if;

            PP_Word (Line (First .. Line'Last));
         end;

         if J /= Lines_To_Print'Last then
            Next_Line_In_Buffer;
            PP_Close_Line;
         end if;
      end loop;

      Line_Pos := Element_Span (E).Last_Column + 1;

      Get_Next_Ada_Lexem;
   end Print_As_Is;

   ----------------------
   -- Print_Rest_As_Is --
   ----------------------

   procedure Print_Rest_As_Is (E : Asis.Element) is
      HT : constant Wide_Character := To_Wide_Character (ASCII.HT);
      E_Span  : constant Span := Element_Span (E);
      CU_Span : constant Span := Compilation_Span (E);
      Lines_To_Print : constant Line_List :=
        Lines (E,
               (First_Line => E_Span.First_Line,
                First_Column => Line_Pos,
                Last_Line => CU_Span.Last_Line,
                Last_Column => CU_Span.Last_Column));

      function Get_Pre_Text_On_Line return Program_Text;
      --  Get the text that appears on the same line as E, preceding E

      function Get_Pre_Text_On_Line return Program_Text is
      begin
         if E_Span.First_Column = 1 then
            return "";

         else
            declare
               Pre_Lines : constant Line_List :=
                 Lines (E,
                        (First_Line => E_Span.First_Line,
                         First_Column => 1,
                         Last_Line => E_Span.First_Line,
                         Last_Column => E_Span.First_Column - 1));
            begin
               return Line_Image (Pre_Lines (Pre_Lines'First));
            end;
         end if;
      end Get_Pre_Text_On_Line;

      Pre_Text_On_Line : constant Program_Text := Get_Pre_Text_On_Line;

      At_Start_Of_Line : constant Boolean :=
        (for all C of Pre_Text_On_Line => C in ' ' | HT);
      --  True if E is at the start of a line, not counting whitespace

   begin
      if At_Start_Of_Line and Output_Pos /= 1 then
         New_Line;
      end if;

      for J in Lines_To_Print'Range loop
         declare
            Line  : constant Program_Text := Line_Image (Lines_To_Print (J));
            First : Natural := Line'First;
         begin
            --  Remove leading blanks from the first line, and adjust Line_Pos
            --  accordingly

            if not At_Start_Of_Line and then J = Lines_To_Print'First then
               while First <= Line'Last and then
                 (Line (First) = ' ' or else Line (First) = HT)
               loop
                  First := First + 1;

                  Line_Pos := Line_Pos + 1;
               end loop;

               --  We want to keep one blank if the preceding text requires it

               if Pre_Text_On_Line /= "" and then
                 Pre_Text_On_Line (Pre_Text_On_Line'Last) = ' '
                 and then First > Line'First
               then
                  First := First - 1;
                  Line_Pos := Line_Pos - 1;
               end if;
            end if;

            PP_Word (Line (First .. Line'Last));
         end;

         if J /= Lines_To_Print'Last then
            Next_Line_In_Buffer;
            PP_Close_Line;
         end if;
      end loop;
   end Print_Rest_As_Is;

   ------------------------
   -- Space_Just_Printed --
   ------------------------

   function Space_Just_Printed return Boolean is
   begin
      return Last_Char_Was_Space;
   end Space_Just_Printed;

end GNATPP.PP_Output;
