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

with GNAT.OS_Lib;               use GNAT.OS_Lib;
with GNAT.UTF_32;

with Asis;                      use Asis;
with Asis.Text;                 use Asis.Text;

with ASIS_UL.Output;            use ASIS_UL.Output;

with GNATPP.Common;             use GNATPP.Common;
with GNATPP.Source_Line_Buffer; use GNATPP.Source_Line_Buffer;
with GNATPP.State;              use GNATPP.State;
with GNATPP.Options;            use GNATPP.Options;
with GNATPP.PP_Output;          use GNATPP.PP_Output;
with GNATPP.Paragraphs;         use GNATPP.Paragraphs;

package body GNATPP.Comments is

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

   Tmp_Line_Buf : Program_Text (1 .. Max_Line_Buf_Len);
   Tmp_Line_Pos : Natural;
   --  The temporary copy of the source line buffer used to expand HTs

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

   function Is_White_Space (C : Wide_Character) return Boolean;
   --  Checks if C is not a white space (that is, ' ' or Wide_HT)

   -----------------------------------------------------------------------
   procedure Output_EOL_Comment_New;
   --  ??? The idea is to output the EOL comment and all the comment lines
   --  which can be considered as continuations of this EOL comment.
   --  After calling this procedure the line buffer has to contain the line
   --  which is not a continuation of this EOL comment.
   --  ??? This procedure closes the last line it outputs

   function Start_Comment (LN : Line_Number_Positive) return Natural;
   --  If the line LN in Lines_Table is a comment line, returns the position
   --  of the first '-' in '--'. Otherwise returns 0.

   function Is_Code_Line (LN : Line_Number_Positive) return Boolean;
   --  Checks if the line LN in Lines_Table is a line containing some piece of
   --  the Ada code (that is, non-blank and non-comment line)

   function Is_Special_Comment return Boolean;
   --  Checks if the comment contained in Line_Buf starting from Line_Pos is
   --  a special comment. Such comments are used for some specific purposes
   --  (such as SPARK annotation, so they should not be changed).

   function Move_Comments_Left (LN : Line_Number_Positive) return Boolean;
   --  Supposing that line LN in Lines_Table is a non-empty code line, checks
   --  that the preceding comment lines in the pretty-printed output should
   --  be moved left to achieve the GNAT-style comment layout

   procedure PP_Comment_Lines
     (Up_To      : Line_Number_Positive;
      Start_From : Natural);
   --  Prints out the sequence of comment lines starting from the Current_Line
   --  up to the line passed as the actual for Up_To parameter. The comment
   --  lines are printed out starting from Start_From. When printing out the
   --  first comment line, the procedure does NOT set the new line, it only
   --  pads the current line up to Start_From position.
   --
   --  After completing this procedure, the Line buffer contains non-comment
   --  and non-blank line with Line_Pos pointing to the first non-blank
   --  character

   procedure PP_Non_Blank_Comment_Lines
     (Up_To      : Line_Number_Positive;
      Start_From : Natural);
   --  Similar as PP_Comment_Lines, but this procedure assumes that all the
   --  lines in between Current_Line and Up_To are non-blank comment lines.
   --
   --  After completing this procedure, the Line buffer contains the line
   --  following Up_To with Line_Pos pointing to the first non-blank
   --  character (if any)

   procedure Reformat_Block
     (Up_To      : Line_Number_Positive;
      Start_From : Positive);
   --  Similar to PP_Non_Blank_Comment_Lines, but this procedure tries to
   --  reformat the text of the comment in the word processor style.

   procedure PP_Comment_Line
     (Start_From     : Positive;
      Long_Len_Error : Boolean := True);
   --  Supposing that the line buffer contains a comment line, and Line_Pos
   --  points to the first '-' of the comment, sends this comment line into
   --  the output. The content of the comment line remains unchanged, except
   --  cutting off the trailing white spaces and adding extra spaces after
   --  '--' if needed in GNAT_Comment_Start mode.
   --  The boolean parameter indicates if the diagnosis for the long comment
   --  line should be generated. In case of a long comment, this procedure
   --  calls itself recursively with this parameter set OFF

   function EOF return Boolean;
   --  Checks if the end of the argument source file is reached

   function Line_Is_Too_Short return Boolean;
   function Too_Big_Indentation return Boolean;
   function Bad_Starting_Part return Boolean;
   --  These functions suppose that the line buffer contains a comment line and
   --  Line_Pos points to the first '-' of '--'. Each of these functions checks
   --  some conditions for the comment line:
   --  - Line_Is_Too_Short - the comment line is too short to be considered
   --       as the start of the reformattable comment block
   --  - Too_Big_Indentation - the distance between starting '--' and the first
   --       non-blank symbol in the comment is too big to consider the line
   --       as the beginning of the reformattable comment block
   --  - Bad_Starting_Part - checks that the comment line starts from double
   --       dash followed by a space character or alphanumeric character and
   --       returns False if it is not the case.

   function Is_Reformattable_Block
     (Up_To : Line_Number_Positive)
      return  Boolean;
   --  Checks that the sequence of comment lines starting from Current line
   --  and limited by Up_To can be considered as a reformattable comment block.

   procedure Expand_Tabs;
   --  If No_Tab_In_Comments is set ON, remove all the HT characters in the
   --  comment stored in the line buffer replacing them with the number of
   --  spaces needed to get to the next tab stop. If the string in the line
   --  buffer VT character in the end, this VT is removed
   --
   --  This procedure is supposed to be called when Line_Pos points to the
   --  beginning of a comment (to the first '-' from '--').

   -----------------------
   -- Bad_Starting_Part --
   -----------------------

   function Bad_Starting_Part return Boolean is
      End_Idx : constant Natural := Get_End_Idx;
      Ch      :          GNAT.UTF_32.UTF_32;
      Result  :          Boolean := False;
   begin

      if End_Idx = Line_Pos + 1 then
         Result := True;
      else
         Ch := Wide_Character'Pos (Line_Buf (Line_Pos + 2));

         Result := not (GNAT.UTF_32.Is_UTF_32_Letter (Ch)
                    or else
                      GNAT.UTF_32.Is_UTF_32_Digit (Ch)
                    or else
                      GNAT.UTF_32.Is_UTF_32_Space (Ch));
      end if;

      return Result;
   end Bad_Starting_Part;

   -----------------
   -- Expand_Tabs --
   -----------------

   procedure Expand_Tabs is
      HT_Expanded_Line_Pos : Positive := Line_Pos;
      --  The position in the original we would have for a given character
      --  if we would have al the HTs expanded with spaces to get to Tab stops.

      Spaces : Positive;
      --  The number of spaces to get to the next tab stop
   begin

      if not No_Tab_In_Comments then
         return;
      end if;

      --  In the source line buffer we have a comment, and Line_Pos points
      --  To the first '-'

      Tmp_Line_Pos := 0;

      for J in Line_Pos .. Line_Len loop

         if Line_Buf (J) = Wide_HT then

            Spaces :=
              (HT_Expanded_Line_Pos + 8) / 8 * 8 - HT_Expanded_Line_Pos + 1;

            for K in 1 .. Spaces loop
               Tmp_Line_Pos := Tmp_Line_Pos + 1;
               Tmp_Line_Buf (Tmp_Line_Pos) := ' ';
            end loop;

            HT_Expanded_Line_Pos := HT_Expanded_Line_Pos + Spaces;

         elsif Line_Buf (J) = Wide_VT then
            exit;
         else
            Tmp_Line_Pos                := Tmp_Line_Pos + 1;
            Tmp_Line_Buf (Tmp_Line_Pos) := Line_Buf (J);
            HT_Expanded_Line_Pos        := HT_Expanded_Line_Pos + 1;
         end if;

      end loop;

      Line_Len := Line_Pos + Tmp_Line_Pos - 1;

      Line_Buf (Line_Pos .. Line_Len) := Tmp_Line_Buf (1 .. Tmp_Line_Pos);

   end Expand_Tabs;

   ------------------------
   -- Get_Next_Ada_Lexem --
   ------------------------

   procedure Get_Next_Ada_Lexem
     (Keep_Empty_Lines       : Boolean := False;
      Called_After_Ada_Token : Boolean := True)
   is
      Prev_Line_Is_Blank   : Boolean := False;
      Blank_Line_Printed   : Boolean := False;
      EOL_Coment_Processed : Boolean := False;
      Next_Code_Line       : Line_Number := 0;
      Last_Comment_Line    : Line_Number_Positive;

      Comment_Start_In_Output : Natural := 0;
      --  Start of the comment in the source line

   begin

      Saved_Last_KW  := Last_KW;
      Saved_Last_Dlm := Last_Dlm;

      if EOF then
         return;
      end if;

      if Called_After_Ada_Token then

         if End_Of_Line_Comment then
            Output_EOL_Comment_New;
            EOL_Coment_Processed := True;
            --  Next_Line_In_Buffer; ???
         else
            Skip_Blanks;

            if Line_Pos /= 0 then

               return;
            else
               Next_Line_In_Buffer;
            end if;

         end if;

      else
         --  Skipping the leading blank lines.
         Next_Line_In_Buffer;

         while Is_Blank_Line loop
            Next_Line_In_Buffer;
         end loop;

      end if;

      --  Skipping the blank lines, if any

      if EOF then
         return;
      end if;

      while Is_Blank_Line loop
         Prev_Line_Is_Blank := True;
         In_Paragraph := False;
         Next_Line_In_Buffer;

         if EOF then
            return;
         end if;

      end loop;

      if Prev_Line_Is_Blank
        and then
         (Keep_Empty_Lines or else
          End_Of_Line_Comment)
      then
         PP_Close_Line;

         if not EOL_Coment_Processed then
            PP_Close_Line;
         end if;

         Blank_Line_Printed := True;
      end if;

      Skip_Blanks;

      if End_Of_Line_Comment then
         if not (The_Very_First_Line  or else
                 EOL_Coment_Processed or else
                 Blank_Line_Printed)
         then
            PP_Close_Line;
         end if;

         --  Looking for the nearest line with Ada code

         for J in GNATPP.State.Current_Line + 1 ..
                  GNATPP.Common.The_Last_Line
         loop

            if Is_Code_Line (J) then
               Next_Code_Line := J;
               exit;
            end if;

         end loop;

         if Format_Comments then
            Comment_Start_In_Output := Logical_Depth * PP_Indentation + 1;

            --  If we are here, we have a sequence of comment lines to print.
            --  In GNAT comment style mode, we have to compute the indentation
            --  first

            if GNAT_Comment_Inden                  and then
               Next_Code_Line > 0                  and then
               Move_Comments_Left (Next_Code_Line) and then
               Comment_Start_In_Output > 1
            then
               Comment_Start_In_Output := Comment_Start_In_Output -
                                          PP_Indentation;
            end if;

         end if;

      else
         return;
      end if;

      if Next_Code_Line = 0 then
         Last_Comment_Line := The_Last_Line;
      else
         Last_Comment_Line := Next_Code_Line - 1;
      end if;

      PP_Comment_Lines
        (Up_To      => Last_Comment_Line,
         Start_From => Comment_Start_In_Output);

      --  Next_Line_In_Buffer; ???

      Skip_Blanks;

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

   -----------------------------
   -- Non_Formattable_Comment --
   -----------------------------

   function Non_Formattable_Comment return Boolean is
      Result : Boolean := False;
   begin

      --  At the moment we are considering as non-formattable comments
      --  ending with '--' (this also includes empty comment lines)

      for J in reverse Line_Pos .. Line_Len loop

         if not Is_White_Space (Line_Buf (J)) then
            Word_End := J;
            exit;
         end if;

      end loop;

      if Line_Buf (Word_End)     = '-' and then
         Line_Buf (Word_End - 1) = '-'
      then
         Result := True;
      end if;

      return Result;

   end Non_Formattable_Comment;

   -----------------------------------------------------------

   ---------
   -- EOF --
   ---------

   function EOF return Boolean is
   begin
      return
         GNATPP.State.Current_Line = GNATPP.Common.The_Last_Line and then
         Line_Pos = 0;
   end EOF;

   ------------------
   -- Is_Code_Line --
   ------------------

   function Is_Code_Line (LN : Line_Number_Positive) return Boolean is
      Line_Img  : constant Program_Text := Line_Image (Lines_Table.Table (LN));
      Non_Blank : Natural      := 0;
      Result    : Boolean      := False;
   begin

      for J in Line_Img'Range loop

         if not Is_White_Space (Line_Img (J)) then
            Non_Blank := J;
            exit;
         end if;

      end loop;

      if not (Non_Blank = 0
            or else
              (Non_Blank < Line_Img'Last  and then
               Line_Img (Non_Blank) = '-' and then
               Line_Img (Non_Blank + 1) = '-'))
      then
         Result := True;
      end if;

      return Result;
   end Is_Code_Line;

   ----------------------------
   -- Is_Reformattable_Block --
   ----------------------------

   function Is_Reformattable_Block
     (Up_To : Line_Number_Positive)
      return  Boolean
   is
      Start_Line    : constant Line_Number_Positive := Current_Line;
      Comment_Start : Positive;
      Text_Start    : Positive;

      Already_Has_Too_Many_Spaces : Boolean;

      Result : Boolean := True;
   begin
      --  We are VERY conservative here. We reject the comment block as
      --  non-reformattable if:
      --  - the comment lines are NOT started from the same positions (that is,
      --    the positions of the '--' are not the same
      --  - the indentation inside the comment lines (that is, the distance
      --    between '--' and the first non-blank character) is not the same for
      --    all the comment lines
      --  - At least one line contains too many spaces at a time
      --  - At least one line contains at least one HT

      Save_Buf;

      Comment_Start := Line_Pos;

      Line_Pos := Line_Pos + 2;
      Skip_Blanks;

      if Line_Pos > 0 and then not HT_Passed then
         Text_Start := Line_Pos;
      else
         --  This means that the comment line contains one word only with
         --  no space between this word and '--' (or there is HT between '--'
         --  and the first word in comment)
         Restore_Buf;
         return False;
      end if;

      Check_Lines : for J in Current_Line .. Up_To loop

         if J > Start_Line then

            if Line_Pos /= Comment_Start then
               Result := False;
               exit Check_Lines;
            else
               Line_Pos := Line_Pos + 2;
               Skip_Blanks;

               if Line_Pos /= Text_Start or else HT_Passed then
                  Result := False;
                  exit Check_Lines;
               end if;

            end if;

         end if;

         --  Now checking the third condition. We
         Already_Has_Too_Many_Spaces := False;

         Check_Spaces : while Line_Pos > 0 loop
            Set_Word_End_In_Comment;
            Skip_Word;

            if HT_Passed then
               Result := False;
               exit Check_Lines;
            end if;

            if Line_Pos - Word_End - 1 >= 3 then
               --  We think that three spaces in a row is already too much
               Result := False;
               exit Check_Lines;
            elsif Line_Pos - Word_End - 1 = 2 then
               --  We allow only one sequence of two spaces in a line

               if Already_Has_Too_Many_Spaces then
                  Result := False;
                  exit Check_Lines;
               else
                  Already_Has_Too_Many_Spaces := True;
               end if;

            end if;

         end loop Check_Spaces;

         Next_Line_In_Buffer;
         Skip_Blanks;
      end loop Check_Lines;

      Restore_Buf;

      return Result;
   end Is_Reformattable_Block;

   ------------------------
   -- Is_Special_Comment --
   ------------------------

   function Is_Special_Comment return Boolean is
      Result :          Boolean            := False;
      Ch     : constant GNAT.UTF_32.UTF_32 :=
        Wide_Character'Pos (Line_Buf (Line_Pos + 2));
   begin
      --  This function assumes that Line_Pos points to the first '-' of the
      --  comment.
      --  See G418-003 for the condition

      Result := not (GNAT.UTF_32.Is_UTF_32_Letter (Ch)
                   or else
                     GNAT.UTF_32.Is_UTF_32_Digit (Ch)
                   or else
                     GNAT.UTF_32.Is_UTF_32_Space (Ch)
                   or else
                     GNAT.UTF_32.Is_UTF_32_Line_Terminator (Ch));

      return Result;
   end Is_Special_Comment;

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

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

   -----------------------
   -- Line_Is_Too_Short --
   -----------------------

   function Line_Is_Too_Short return Boolean is
      End_Idx : constant Natural := Get_End_Idx;
   begin
      return End_Idx - Line_Pos < Too_Short_Comment;
   end Line_Is_Too_Short;

   ------------------------
   -- Move_Comments_Left --
   ------------------------

   function Move_Comments_Left (LN : Line_Number_Positive) return Boolean is
      Line_Img : constant Program_Text := Line_Image (Lines_Table.Table (LN));
      Result   : Boolean      := False;
      First_Idx, Last_Idx     : Natural := 0;

      First_Word : String_Access;
   begin

      for J in Line_Img'Range loop

         if not Is_White_Space (Line_Img (J)) then
            First_Idx := J;
            exit;
         end if;

      end loop;

      Last_Idx := Line_Img'Last;

      for J in First_Idx .. Last_Idx loop

         if Line_Img (J) = ' '     or else
            Line_Img (J) = Wide_HT or else
            Line_Img (J) =  '('    or else
            Line_Img (J) =  '''    or else
            Line_Img (J) =  '"'
         then
            Last_Idx := J - 1;
            exit;
         end if;

      end loop;

      First_Word :=
         new String'(To_Lower (To_String (Line_Img (First_Idx .. Last_Idx))));

      if First_Word.all = "begin"
        or else (First_Word.all = "when" and then Last_KW /= KW_Is)
        or else First_Word.all = "elsif"
        or else First_Word.all = "else"
      then
         Result := True;
      end if;

      return Result;
   end Move_Comments_Left;

   ----------------------------
   -- Output_EOL_Comment_New --
   ----------------------------

   procedure Output_EOL_Comment_New is

      Last_In_Sequence : Line_Number_Positive := Current_Line;
      --  Should be set to the number of the last line which can be considered
      --  as a continuation of the EOL comment

      Last_Ada_Code_Char : Positive;

      Comment_Start_In_Output : Positive;
      --  Start of the comment in the source line

      To_Be_Continued : Boolean := False;
      --  Flag indicating if this EOL comment will be continued in the next
      --  comment line

      Comment_Len : constant Natural := Get_End_Idx - Line_Pos + 1;

   begin

      Expand_Tabs;

      --  1. Try to define if this EOL comment is continued in the next comment
      --     lines

      for J in GNATPP.State.Current_Line + 1 ..
               GNATPP.Common.The_Last_Line
      loop

         if Start_Comment (J) /= Line_Pos then
            Last_In_Sequence := J - 1;
            exit;
         end if;

      end loop;

      --  2. Define the comment start position in the output

      for J in reverse 1 .. Line_Pos - 1 loop

         if not Is_White_Space (Line_Buf (J)) then
            Last_Ada_Code_Char := J;
            exit;
         end if;

      end loop;

      if Format_Comments
        and then
         Output_Pos + (Line_Pos - Last_Ada_Code_Char - 1) +
         3 * PP_Indentation > Max_Line_Length
        and then
          not (Output_Pos + (Line_Pos - Last_Ada_Code_Char - 1) + Comment_Len <
               Max_Line_Length)
        and then
          not (Preserve_Special_Comments
             and then
               Is_Special_Comment)
      then
         --  The meaning of this terrible condition is: if there is a very
         --  little room in the line for EOL comment, and the comment itself
         --  is not very short...

         SLOC_Warning
           (Message => "there is no space for correct formatting " &
                       "of end-of-line comment",
            SLOC    => Get_Current_SLOC);

         if Output_Pos + 5 + PP_Indentation > Max_Line_Length then
            SLOC_Warning
              (Message => "end-of-line comment is transformed into " &
                            "a comment line",
               SLOC    => Get_Current_SLOC);
            PP_New_Line;
            Comment_Start_In_Output := Output_Pos;
         else
            Comment_Start_In_Output := Output_Pos + 1;
            --  We need at least one space to be '-gnaty-compatible'
         end if;

      else
         Comment_Start_In_Output :=
            Output_Pos + (Line_Pos - Last_Ada_Code_Char - 1);
      end if;

      if not Is_New_Output_Line then
         --  If, because of some reason, we have to continue this EOL comment
         --  on the next line, we set the comment beginning to the nearest
         --  multiple of indentation level

         To_Be_Continued := Last_In_Sequence > Current_Line;

         if Format_Comments and then not To_Be_Continued then
            --  Check if we will have to split this EOL comment because it is
            --  too long

            To_Be_Continued :=
               Comment_Start_In_Output + Comment_Len >
               Max_Line_Length;
         end if;

         if To_Be_Continued and then
            Comment_Start_In_Output rem PP_Indentation /= 1
         then
            Comment_Start_In_Output := Comment_Start_In_Output +
               (PP_Indentation -
                (Comment_Start_In_Output - 1) rem PP_Indentation);
         end if;

      end if;

      PP_Non_Blank_Comment_Lines
        (Last_In_Sequence, Comment_Start_In_Output);

   end Output_EOL_Comment_New;

   ----------------------
   -- PP_Comment_Lines --
   ----------------------

   procedure PP_Comment_Lines
     (Up_To      : Line_Number_Positive;
      Start_From : Natural)
   is
      Last_Line  : Line_Number_Positive;
      --  Indicates the end of the sequence of non-blank comment lines (the
      --  sequence starts from Current_Line)

      function Get_Last_Line return Line_Number;
      --  Computes Last_Line

      function Get_Last_Line return Line_Number is
         Result : Line_Number;
      begin
         Save_Buf;

         while not Is_Blank_Line                          and then
               Current_Line < GNATPP.Common.The_Last_Line and then
               Current_Line <= Up_To
         loop
            Next_Line_In_Buffer;
         end loop;

         if Is_Blank_Line or else
            Current_Line > Up_To
         then
            Result := Current_Line - 1;
         else
            Result := Current_Line;
         end if;

         Restore_Buf;

         return Result;
      end Get_Last_Line;
   begin
      --  if we are here, we have a sequence of lines starting from
      --  Current_Line and ending with Up_To, and each of these lines is
      --  either a comment line or a blank line.

      In_Paragraph := False;

      loop
         Last_Line := Get_Last_Line;
         --  PP_New_Line_And_Pad (Start_From); ???
         PP_Non_Blank_Comment_Lines (Last_Line, Start_From);

         --  Skipping the empty lines, if any

         if Last_Line < Up_To then
            Next_Line_In_Buffer;

            while Is_Blank_Line         and then
                  Current_Line <= Up_To and then
                  Current_Line <  GNATPP.Common.The_Last_Line
            loop
               Next_Line_In_Buffer;
            end loop;

            if not (Current_Line = GNATPP.Common.The_Last_Line and then
                    Is_Blank_Line)
            then
               --  Otherwise we will get an extra blank line after the last
               --  comment AFTER the compilation unit
               PP_Close_Line;
            end if;

            if Is_Blank_Line then
               exit;
            end if;

         else
            exit;
         end if;

      end loop;

   end PP_Comment_Lines;

   ---------------------
   -- PP_Comment_Line --
   ---------------------

   procedure PP_Comment_Line
     (Start_From     : Positive;
      Long_Len_Error : Boolean := True)
   is
      End_Idx          : Natural;
      First_Word_Start : Natural := 0;
      Rough_Split      : Natural := 0;
      Split_At         : Natural := 0;
      Start_Next       : Natural := 0;
      Add_Spaces       : Natural := 0;
   begin
      Expand_Tabs;

      PP_Pad_Up_To (Start_From);

      Skip_Blanks;

      End_Idx := Get_End_Idx;

      if not Format_Comments
        or else
          (Preserve_Special_Comments
          and then
           Is_Special_Comment)
      then
         Put (Line_Buf (Line_Pos .. End_Idx));
         PP_Close_Line;
         return;
      end if;

      if End_Idx > Line_Pos + 1 then

         for J in Line_Pos + 2 .. End_Idx loop

            if not Is_White_Space (Line_Buf (J)) then
               First_Word_Start := J;
               exit;
            end if;

         end loop;

      end if;

      if GNAT_Comment_Start         and then
        not Non_Formattable_Comment and then
        not Bad_Starting_Part
      then

         if First_Word_Start = Line_Pos + 2 then
            Add_Spaces := 2;
         elsif First_Word_Start = Line_Pos + 3 then
            Add_Spaces := 1;
         end if;

      end if;

      if Output_Pos + (End_Idx - Line_Pos + 1) + Add_Spaces - 1 <=
         Max_Line_Length
      then
         Put ("--");

         if End_Idx > Line_Pos + 1 then

            for J in 1 .. Add_Spaces loop
               Put (' ');
            end loop;

            Put (Line_Buf (Line_Pos + 2 .. End_Idx));
         end if;

         PP_Close_Line;

         return;

      elsif Long_Len_Error then
         SLOC_Warning
           (Message => "comment line is too long and can not be " &
                       "formatted correctly",
            SLOC    => Get_Current_SLOC);
      end if;

      --  And here we have to deal with the long comment line...

      PP_Word ("--");

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

      Rough_Split := Line_Pos + Available_In_Output - 1;
      --  Rough_Split can not be bigger that End_Idx, otherwise we would not
      --  have to split the comment line

      --  If we are in the middle of the word, set Start_Next to the beginning
      --  of this word and Split_At to the end of previous word, if we are in
      --  between words, we have to set Start_Next to the beginning of the next
      --  word, and Split_At - to the end of the previous word. In both cases
      --  we first try to detect the situation when any reasonable splitting is
      --  not possible.

      if Is_White_Space (Line_Buf (Rough_Split)) then

         for J in reverse Line_Pos .. Rough_Split loop

            if not Is_White_Space (Line_Buf (J)) then
               Split_At := J;
               exit;
            end if;

         end loop;

      else

         for J in reverse Line_Pos .. Rough_Split loop

            if Is_White_Space (Line_Buf (J)) then
               Start_Next := J + 1;
               exit;
            end if;

         end loop;

      end if;

      --  Check if we can have a reasonable splitting, and if we can - define
      --  the second split parameter, otherwise just split at Rough_Split:

      if Is_White_Space (Line_Buf (Rough_Split)) and then
         Split_At > First_Word_Start
      then

         for J in Rough_Split + 1 .. End_Idx loop

            if not Is_White_Space (Line_Buf (J)) then
               Start_Next := J;
               exit;
            end if;

         end loop;

      elsif not Is_White_Space (Line_Buf (Rough_Split)) and then
         Start_Next > First_Word_Start
      then

         for J in reverse Line_Pos .. Start_Next - 1 loop

            if not Is_White_Space (Line_Buf (J)) then
               Split_At := J;
               exit;
            end if;

         end loop;

      else
         Split_At   := Rough_Split;
         Start_Next := Split_At + 1;
      end if;

      PP_Word (Line_Buf (Line_Pos .. Split_At));
      PP_Close_Line;

      Line_Pos := Start_Next;
      Line_Pos := Line_Pos - 2;
      Line_Buf (Line_Pos .. Line_Pos + 1) := "--";

      PP_Comment_Line
        (Start_From,
         Long_Len_Error => False);

   end PP_Comment_Line;

   --------------------------------
   -- PP_Non_Blank_Comment_Lines --
   --------------------------------

   procedure PP_Non_Blank_Comment_Lines
     (Up_To      : Line_Number_Positive;
      Start_From : Natural)
   is
      Start_Block : Line_Number;
      End_Block   : Line_Number;
      --  Indexes of the comment lines sequence which may be considered as
      --  a reformattable comment block. Start_Comment_Block set to Up_To + 1
      --  means that there is no potentially reformattable blocks between
      --  Current_Line and Up_To.

      function Get_Start_Block return Line_Number;
      function Get_End_Block   return Line_Number;
      --  These two functions try to select the potentially reformattable
      --  comment block. In case if there is no such block any more, they
      --  return zero.

      procedure PP_Comment_Lines_As_Is (Up_To_Line : Line_Number_Positive);
      --  Prints out a sequence of comment lines from Current_Line to
      --  Up_To_Line making no change inside the comments except cutting out
      --  the trailing spaces

      -------------------
      -- Get_End_Block --
      -------------------

      function Get_End_Block return Line_Number is
         Result : Line_Number := Start_Block;
      begin
         --  Current_Line is equal to the latest setting of Start_Block
         Save_Buf;

         while Current_Line <= Start_Block
            and then
               Current_Line < GNATPP.Common.The_Last_Line
         loop
            Next_Line_In_Buffer;
            Skip_Blanks;
         end loop;

         while Current_Line <= Up_To loop

            --  At the moment the condition is very similar to what is
            --  used in Get_Start_Block, except that the short line can be the
            --  end of the reformattable block

            if False
               or else Non_Formattable_Comment
               or else Too_Big_Indentation
               or else (Preserve_Special_Comments
                       and then
                        Is_Special_Comment)
               or else Bad_Starting_Part
            then
               Result := Current_Line - 1;
               exit;
            else
               Result := Current_Line;
               Next_Line_In_Buffer;
               exit when EOF;
               Skip_Blanks;
            end if;

         end loop;

         Restore_Buf;

         return Result;
      end Get_End_Block;

      ---------------------
      -- Get_Start_Block --
      ---------------------

      function Get_Start_Block return Line_Number is
         Result : Line_Number := 0;
      begin
         Save_Buf;

         while Current_Line <= Up_To loop

            Skip_Blanks;

            if False
               or else Non_Formattable_Comment
               or else Line_Is_Too_Short
               or else Too_Big_Indentation
               or else (Preserve_Special_Comments
                       and then
                        Is_Special_Comment)
            then
               Result := Current_Line + 1;
               Next_Line_In_Buffer;
               exit when EOF;
            else
               Result := Current_Line;
               exit;
            end if;

         end loop;

         Restore_Buf;

         return Result;
      end Get_Start_Block;

      ----------------------------
      -- PP_Comment_Lines_As_Is --
      ----------------------------

      procedure PP_Comment_Lines_As_Is (Up_To_Line : Line_Number_Positive) is
         Start_Comment_From : Natural := Start_From;
      begin

         while Current_Line <= Up_To_Line loop

            Skip_Blanks;

            if not Format_Comments and then Start_From = 0 then
               Start_Comment_From := Line_Pos;
            end if;

            PP_Comment_Line (Start_Comment_From);
            Next_Line_In_Buffer;
            exit when EOF;
         end loop;

      end PP_Comment_Lines_As_Is;

   begin --  PP_Non_Blank_Comment_Lines

      if not Format_Comments or else not Reformat_Comment_Block then
         PP_Comment_Lines_As_Is (Up_To);
         return;
      end if;

      Start_Block := Get_Start_Block;

      while Start_Block > 0 and then Current_Line <= Up_To loop
         exit when EOF; --  Just in case

         if Start_Block = Up_To + 1 then
            PP_Comment_Lines_As_Is (Up_To);
            return;
         else

            --  Printing lines (if any) before the block.
            if Start_Block > Current_Line then
               PP_Comment_Lines_As_Is (Start_Block - 1);
            end if;

            End_Block := Get_End_Block;
         end if;

         if Is_Reformattable_Block (End_Block) then
            Reformat_Block (End_Block, Start_From);
         else
            PP_Comment_Lines_As_Is (End_Block);
         end if;

         Start_Block := Get_Start_Block;
      end loop;

   end PP_Non_Blank_Comment_Lines;

   --------------------
   -- Reformat_Block --
   --------------------

   procedure Reformat_Block
     (Up_To      : Line_Number_Positive;
      Start_From : Positive)
   is
      Comment_Start : Positive;
      Add_Spaces    : Natural;

      procedure Fill_Next_Comment_Line;
      --  Forms the new line of the reformatted comment block

      procedure Fill_Next_Comment_Line is
         Word_Len : Positive;
      begin
         PP_Pad_Up_To (Start_From);

         PP_Word_No_Move ("--");

         for J in 1 .. Add_Spaces loop
            PP_Word_No_Move (" ");
         end loop;

         Skip_Blanks;

         loop

            --  Set_Word_End;
            Set_Word_End_In_Comment;
            Word_Len := Word_End - Line_Pos + 1;

            if Word_Len > Available_In_Output
              or else
               (Output_Pos > Start_From + 2 + Add_Spaces and then
                Word_Len + 1 > Available_In_Output)
            then

               if Output_Pos = Start_From + 2 + Add_Spaces then
                  --  We can not correctly output this word even as the first
                  --  word in the line!
                  SLOC_Warning
                    (Message => "comment line is too long and can not be " &
                                "formatted correctly",
                     SLOC    => Get_Current_SLOC);

                  PP_Word (Line_Buf (Line_Pos ..
                                     Line_Pos + Available_In_Output - 1));
                  exit;

               else
                  --  let's try on the new line
                  exit;
               end if;

            else
               if Output_Pos /= Start_From + 2 + Add_Spaces then
                  PP_Word_No_Move (" ");
               end if;

               PP_Word (Line_Buf (Line_Pos .. Word_End));
            end if;

            --  We can be here only if we've just put one more word in the
            --  output line

            Skip_Blanks;

            if Line_Pos = 0 then
               Next_Line_In_Buffer;
               exit when EOF;

               Skip_Blanks;

               if Current_Line > Up_To then
                  exit;
               else
                  --  Skipping the leading '--' and spaces after
                  Skip_Blanks;
                  Line_Pos := Line_Pos + 2;
                  Skip_Blanks;
               end if;

            end if;

         end loop;

         PP_Close_Line;

      end Fill_Next_Comment_Line;

   begin

      Skip_Blanks; --  ??? do we need it here?

      --  Set Line_Pos and Word_End to point to the first word in the first
      --  comment line in the comment block to reformat

      Comment_Start := Line_Pos; --  Points to the firts '-'
      Line_Pos      := Line_Pos + 2;
      Skip_Blanks;

      Add_Spaces := Line_Pos - Comment_Start - 2;

      if GNAT_Comment_Start and then Add_Spaces <= 1 then
         Add_Spaces := 2;
      end if;

      while Current_Line <= Up_To and then
            Line_Pos /= 0
      loop
         Fill_Next_Comment_Line;
      end loop;

   end Reformat_Block;

   -------------------
   -- Start_Comment --
   -------------------

   function Start_Comment (LN : Line_Number_Positive) return Natural is
      Line_Img : constant Program_Text := Line_Image (Lines_Table.Table (LN));
      Result   : Natural      := 0;
   begin

      --  HT are NOT taken into account!!!

      for J in Line_Img'Range loop

         if not Is_White_Space (Line_Img (J)) then
            Result := J;
            exit;
         end if;

      end loop;

      if not (Result > 0              and then
              Result < Line_Img'Last  and then
              Line_Img (Result) = '-' and then
              Line_Img (Result + 1) = '-')
      then
         Result := 0;
      end if;

      return Result;
   end Start_Comment;

   -------------------------
   -- Too_Big_Indentation --
   -------------------------

   function Too_Big_Indentation return Boolean is
      First_Char : Positive := Line_Len;
   begin

      for J in Line_Pos + 2 .. Line_Len loop

         if not Is_White_Space (Line_Buf (J)) then
            First_Char := J;
            exit;
         end if;

      end loop;

      return First_Char - Line_Pos - 3 > Max_Commment_Indentation;

   end Too_Big_Indentation;

end GNATPP.Comments;
