------------------------------------------------------------------------------
--                                                                          --
--                            GNATPP COMPONENTS                             --
--                                                                          --
--            G N A T P P . S O U R C E _ L I N E _ B U F F E R             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2001-2009, 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_UL.Options;

with GNATPP.State;            use GNATPP.State;

package body GNATPP.Source_Line_Buffer is

   Wide_HT : constant Wide_Character := To_Wide_Character (ASCII.HT);

   Old_Current_Line : Line_Number_Positive;
   Old_Line_Pos     : Natural;
   --  These variables are used to save and to restore the content of the
   --  line buffer

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

   function Skip_Blanks return Natural;
   --  Returns the index of the first non-blank position which follows
   --  Line_Pos (ASCII.HT is considered as blank). If the rest of the line
   --  in the line buffer contains only blanks, this function returns 0.

   function Is_White_Space (W_Ch : Wide_Character) return Boolean;
   --  Checks if the argument is the space of HT character.

   ----------------------
   -- Detect_Delimiter --
   ----------------------

   procedure Detect_Delimiter is
   begin

      case Line_Buf (Line_Pos) is
         when '&' =>
            Delimiter := Ampersand_Dlm;
         when ''' =>
            Delimiter := Tick_Dlm;
         when '(' =>
            Delimiter := Left_Parenthesis_Dlm;
         when ')' =>
            Delimiter := Right_Parenthesis_Dlm;

         when '*' =>

            if Line_Pos < Line_Len and then
               Line_Buf (Line_Pos + 1) = '*'
            then
               Delimiter := Double_Star_Dlm;
            else
               Delimiter := Asterisk_Dlm;
            end if;

         when '+' =>
            Delimiter := Plus_Dlm;
         when ',' =>
            Delimiter := Comma_Dlm;
         when '-' =>
            --  This function is not supposed to be called in the situation
            --  when Line_Pos points to the beginning of a comment
            Delimiter := Minus_Dlm;

         when '.' =>

            if Line_Pos < Line_Len and then
               Line_Buf (Line_Pos + 1) = '.'
            then
               Delimiter := Double_Dot_Dlm;
            else
               Delimiter := Dot_Dlm;
            end if;

         when '/' =>

            if Line_Pos < Line_Len and then
               Line_Buf (Line_Pos + 1) = '='
            then
               Delimiter := Inequality_Dlm;
            else
               Delimiter := Divide_Dlm;
            end if;

         when ':' =>

            if Line_Pos < Line_Len and then
               Line_Buf (Line_Pos + 1) = '='
            then
               Delimiter := Assignment_Dlm;
            else
               Delimiter := Colon_Dlm;
            end if;

         when ';' =>
            Delimiter := Semicolon_Dlm;

         when '<' =>

            if Line_Pos < Line_Len and then
               Line_Buf (Line_Pos + 1) = '='
            then
               Delimiter := Less_Or_Equal_Dlm;
            elsif Line_Pos < Line_Len and then
                    Line_Buf (Line_Pos + 1) = '>'
            then
               Delimiter := Box_Dlm;
            elsif Line_Pos < Line_Len and then
                    Line_Buf (Line_Pos + 1) = '<'
            then
               Delimiter := Left_Label_Bracket_Dlm;
            else
               Delimiter := Less_Than_Dlm;
            end if;

         when '=' =>

            if Line_Pos < Line_Len and then
               Line_Buf (Line_Pos + 1) = '>'
            then
               Delimiter := Arrow_Dlm;
            else
               Delimiter := Equals_Dlm;
            end if;

         when '|' =>
            Delimiter := Vertical_Line_Dlm;

         when '!' =>
            Delimiter := Exclamation_Mark_Dlm;

         when '>' =>

            if Line_Pos < Line_Len and then
               Line_Buf (Line_Pos + 1) = '='
            then
               Delimiter := Greater_Or_Equal_Dlm;
            elsif Line_Pos < Line_Len and then
                    Line_Buf (Line_Pos + 1) = '>'
            then
               Delimiter := Right_Label_Bracket_Dlm;
            else
               Delimiter := Greater_Than_Dlm;
            end if;

         when  others =>
            Delimiter := Not_A_Dlm;
      end case;

   end Detect_Delimiter;

   --------------------
   -- Detect_Keyword --
   --------------------

   procedure Detect_Keyword is
   begin
      Keyword := Not_A_KW;

      Skip_Blanks;

      if not (Current_Line = GNATPP.Common.The_Last_Line and then
              Line_Pos = 0)
      then
         Set_Word_End;

         if Word_End > 0 and then
            Line_Buf (Word_End) = ';'
         then
            Word_End := Word_End - 1;
         end if;

         declare
            Word : constant Program_Text := Normalized_Word;
         begin

            if Word = Abort_String        then
               Keyword := KW_Abort;
            elsif Word = Abs_String       then
               Keyword := KW_Abs;
            elsif Word = Abstract_String  then
               Keyword := KW_Abstract;
            elsif Word = Accept_String    then
               Keyword := KW_Accept;
            elsif Word = Access_String    then
               Keyword := KW_Access;
            elsif Word = Aliased_String   then
               Keyword := KW_Aliased;
            elsif Word = All_String       then
               Keyword := KW_All;
            elsif Word = And_String       then
               Keyword := KW_And;
            elsif Word = Array_String     then
               Keyword := KW_Array;
            elsif Word = At_String        then
               Keyword := KW_At;
            elsif Word = Begin_String     then
               Keyword := KW_Begin;
            elsif Word = Body_String      then
               Keyword := KW_Body;
            elsif Word = Case_String      then
               Keyword := KW_Case;
            elsif Word = Constant_String  then
               Keyword := KW_Constant;
            elsif Word = Declare_String   then
               Keyword := KW_Declare;
            elsif Word = Delay_String     then
               Keyword := KW_Delay;
            elsif Word = Delta_String     then
               Keyword := KW_Delta;
            elsif Word = Digits_String    then
               Keyword := KW_Digits;
            elsif Word = Do_String        then
               Keyword := KW_Do;
            elsif Word = Else_String      then
               Keyword := KW_Else;
            elsif Word = Elsif_String     then
               Keyword := KW_Elsif;
            elsif Word = End_String       then
               Keyword := KW_End;
            elsif Word = Entry_String     then
               Keyword := KW_Entry;
            elsif Word = Exception_String then
               Keyword := KW_Exception;
            elsif Word = Exit_String      then
               Keyword := KW_Exit;
            elsif Word = For_String       then
               Keyword := KW_For;
            elsif Word = Function_String  then
               Keyword := KW_Function;
            elsif Word = Generic_String   then
               Keyword := KW_Generic;
            elsif Word = Goto_String      then
               Keyword := KW_Goto;
            elsif Word = If_String        then
               Keyword := KW_If;
            elsif Word = In_String        then
               Keyword := KW_In;
            elsif Word = KW_Is_String     then
               Keyword := KW_Is;
            elsif Word = Limited_String   then
               Keyword := KW_Limited;
            elsif Word = Loop_String      then
               Keyword := KW_Loop;
            elsif Word = Mod_String       then
               Keyword := KW_Mod;
            elsif Word = New_String       then
               Keyword := KW_New;
            elsif Word = Not_String       then
               Keyword := KW_Not;
            elsif Word = Null_String      then
               Keyword := KW_Null;
            elsif Word = Of_String        then
               Keyword := KW_Of;
            elsif Word = Or_String        then
               Keyword := KW_Or;
            elsif Word = Others_String    then
               Keyword := KW_Others;
            elsif Word = Out_String       then
               Keyword := KW_Out;
            elsif Word = Package_String   then
               Keyword := KW_Package;
            elsif Word = Pragma_String    then
               Keyword := KW_Pragma;
            elsif Word = Private_String   then
               Keyword := KW_Private;
            elsif Word = Procedure_String then
               Keyword := KW_Procedure;
            elsif Word = Protected_String then
               Keyword := KW_Protected;
            elsif Word = Raise_String     then
               Keyword := KW_Raise;
            elsif Word = Range_String     then
               Keyword := KW_Range;
            elsif Word = Record_String    then
               Keyword := KW_Record;
            elsif Word = Rem_String       then
               Keyword := KW_Rem;
            elsif Word = Renames_String   then
               Keyword := KW_Renames;
            elsif Word = Requeue_String   then
               Keyword := KW_Requeue;
            elsif Word = Return_String    then
               Keyword := KW_Return;
            elsif Word = Reverse_String   then
               Keyword := KW_Reverse;
            elsif Word = Select_String    then
               Keyword := KW_Select;
            elsif Word = Separate_String  then
               Keyword := KW_Separate;
            elsif Word = Subtype_String   then
               Keyword := KW_Subtype;
            elsif Word = Tagged_String    then
               Keyword := KW_Tagged;
            elsif Word = Task_String      then
               Keyword := KW_Task;
            elsif Word = Terminate_String then
               Keyword := KW_Terminate;
            elsif Word = Then_String      then
               Keyword := KW_Then;
            elsif Word = Type_String      then
               Keyword := KW_Type;
            elsif Word = Until_String     then
               Keyword := KW_Until;
            elsif Word = Use_String       then
               Keyword := KW_Use;
            elsif Word = When_String      then
               Keyword := KW_When;
            elsif Word = While_String     then
               Keyword := KW_While;
            elsif Word = With_String      then
               Keyword := KW_With;
            elsif Word = Xor_String       then
               Keyword := KW_Xor;

            elsif ASIS_UL.Options.ASIS_2005_Mode_Explicitely_Set then
            --  Ada 2005 keywords:

               if Word = Interface_String    then
                  Keyword := KW_Interface;
               elsif Word = Overriding_String   then
                  Keyword := KW_Overriding;
               elsif Word = Synchronized_String then
                  Keyword := KW_Synchronized;
               end if;

            end if;

         end;

      end if;

   end Detect_Keyword;

   -------------------------
   -- End_Of_Line_Comment --
   -------------------------

   function End_Of_Line_Comment return Boolean is
      Result : Boolean          := False;
      Idx    : constant Natural := Skip_Blanks;
   begin

      if not (Idx = 0 or else
              Idx = Line_Len)
      then
         Result   := Line_Buf (Idx) = '-' and then
                     Line_Buf (Idx + 1) = '-';
         Line_Pos := Idx;
      end if;

      return Result;

   end End_Of_Line_Comment;

   -----------------
   -- Get_End_Idx --
   -----------------

   function Get_End_Idx return Natural is
      Result : Natural := 0;
   begin

      for J in reverse Line_Pos .. Line_Len loop

         if not (Line_Buf (J) = ' ' or else
                 Line_Buf (J) = To_Wide_Character (ASCII.HT))
         then
            Result := J;
            exit;
         end if;

      end loop;

      return Result;

   end Get_End_Idx;

   ---------------
   -- In_Buffer --
   ---------------

   procedure In_Buffer (Str_Num : Line_Number_Positive) is
      The_line : constant Line := Lines_Table.Table (Str_Num);
   begin
      GNATPP.State.Current_Line := Str_Num;
      Line_Len                  := Length (The_line);
      Line_Buf (1 .. Line_Len)  := Line_Image (The_line);

      if Line_Len = 0 then
         Line_Pos := 0;
      else
         Line_Pos := 1;
      end if;

   end In_Buffer;

   -------------------
   -- Is_Blank_Line --
   -------------------

   function Is_Blank_Line return Boolean is
   begin
      return Skip_Blanks = 0;
   end Is_Blank_Line;

   --------------------
   -- Is_White_Space --
   --------------------

   function Is_White_Space (W_Ch : Wide_Character) return Boolean is
   begin
      return W_Ch = ' ' or else W_Ch = Wide_HT;
   end Is_White_Space;

   -------------------------
   -- Next_Line_In_Buffer --
   -------------------------

   procedure Next_Line_In_Buffer is
   begin

      if Current_Line < GNATPP.Common.The_Last_Line then
         In_Buffer (Current_Line + 1);
      else
         Line_Pos := 0;
      end if;

   end Next_Line_In_Buffer;

   ---------------------
   -- Normalized_Word --
   ---------------------

   function Normalized_Word return Program_Text is
      Result : Program_Text := Line_Buf (Line_Pos .. Word_End);
   begin

      if Is_String (Result) then
         Result := To_Wide_String (To_Lower (To_String (Result)));
      end if;

      return Result;

   end Normalized_Word;

   -----------------
   -- Restore_Buf --
   -----------------

   procedure Restore_Buf is
   begin
      In_Buffer (Old_Current_Line);
      Line_Pos := Old_Line_Pos;
   end Restore_Buf;

   --------------
   -- Save_Buf --
   --------------

   procedure Save_Buf is
   begin
      Old_Current_Line := Current_Line;
      Old_Line_Pos     := Line_Pos;
   end Save_Buf;

   ------------------
   -- Set_Word_End --
   ------------------

   procedure Set_Word_End is
   begin
      Word_End := Line_Pos;

      if Word_End /= 0 then

         while Word_End < Line_Len loop

            if not (Is_Alphanumeric (To_Character (Line_Buf (Word_End)))
                 or else
                    To_Character (Line_Buf (Word_End)) = '_')
            then
               exit;
            else
               Word_End := Word_End + 1;
            end if;

         end loop;

         if not Is_Alphanumeric (To_Character (Line_Buf (Word_End))) then
            Word_End := Word_End - 1;
         end if;

      end if;

   end Set_Word_End;

   -----------------------------
   -- Set_Word_End_In_Comment --
   -----------------------------

   procedure Set_Word_End_In_Comment is
   begin
      Word_End := Line_Pos;

      if Word_End /= 0 then

         while Word_End < Line_Len loop

            if Is_White_Space (Line_Buf (Word_End)) then
               exit;
            else
               Word_End := Word_End + 1;
            end if;

         end loop;

         if Is_White_Space (Line_Buf (Word_End)) then
            Word_End := Word_End - 1;
         end if;

      end if;

   end Set_Word_End_In_Comment;

   -----------------
   -- Skip_Blanks --
   -----------------

   function Skip_Blanks return Natural is
      Result : Natural := Line_Pos;
   begin
      HT_Passed := False;

      if Result > Line_Len then
         Result := 0;
      elsif Result > 0 then

         while Line_Buf (Result) = ' '                          or else
               Line_Buf (Result) = To_Wide_Character (ASCII.HT) or else
               Line_Buf (Result) = To_Wide_Character (ASCII.FF) or else
               Line_Buf (Result) = To_Wide_Character (ASCII.VT)
         loop
            Result := Result + 1;

            if Result > Line_Len then
               Result := 0;
               HT_Passed := False;
               exit;
            end if;

            if Line_Buf (Result) = To_Wide_Character (ASCII.HT) then
               HT_Passed := True;
            end if;

         end loop;

      end if;

      return Result;

   end Skip_Blanks;

   -----------------
   -- Skip_Blanks --
   -----------------

   procedure Skip_Blanks is
   begin
      Line_Pos := Skip_Blanks;
   end Skip_Blanks;

   ---------------
   -- Skip_Word --
   ---------------

   procedure Skip_Word is
   begin
      Skip_Blanks;

      if Line_Pos > 0 then

         --  skipping the word

         while not (Line_Buf (Line_Pos) = ' ' or else
                    Line_Buf (Line_Pos) = To_Wide_Character (ASCII.HT))
            and then
               Line_Pos <= Line_Len
         loop
            Line_Pos := Line_Pos + 1;
         end loop;

         Skip_Blanks;
      end if;

   end Skip_Word;

end GNATPP.Source_Line_Buffer;
