------------------------------------------------------------------------------
-- --
-- Libadalang Tools --
-- --
-- Copyright (C) 2001-2022, AdaCore --
-- --
-- Libadalang Tools is free software; you can redistribute it and/or modi- --
-- fy it under terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 3, or (at your option) any --
-- later version. This software is distributed in the hope that it will be --
-- useful but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and a --
-- copy of the GCC Runtime Library Exception along with this program; see --
-- the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- . --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Finalization;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with GNATCOLL.Paragraph_Filling;
with Libadalang.Common;
with Utils.Command_Lines.Common;
with Utils.Err_Out;
with Utils.Formatted_Output;
with Utils.Generic_Formatted_Output;
with Utils.Symbols; use Utils.Symbols;
with Langkit_Support.Slocs; use Langkit_Support;
with Pp.Command_Lines; use Pp.Command_Lines;
with Pp.Error_Slocs; use Pp.Error_Slocs;
with Pp.Scanner.Lines;
package body Pp.Formatting is
use Utils.Command_Lines;
use Pp_Flag_Switches, Pp_Boolean_Switches, Pp_Nat_Switches;
function Next_Enabled
(Lines_Data : Lines_Data_Rec;
F : Line_Break_Index_Index)
return Line_Break_Index_Index;
-- Next currently-enabled line break after F. Thus, F..Next_Enabled(F) is a
-- line.
procedure Tokns_To_Buffer
(Buf : in out Buffer; Tokns : Scanner.Tokn_Vec;
Cmd : Utils.Command_Lines.Command_Line);
-- Turns a sequence of tokens back into text. Overwrites Buf, and leaves
-- 'point' at the beginning. Whole_Line_Comment takes their indentation
-- from the previous Spaces token, if any.
-- The following Next_ss/Prev_ss are the same as Scanner.Next/Prev, except
-- they skip a following Spaces token, if present. The "ss" stands for
-- "skip spaces".
function Next_ss (Cur : Scanner.Tokn_Cursor) return Scanner.Tokn_Cursor;
procedure Next_ss (Cur : in out Scanner.Tokn_Cursor);
function Prev_ss (Cur : Scanner.Tokn_Cursor) return Scanner.Tokn_Cursor;
procedure Prev_ss (Cur : in out Scanner.Tokn_Cursor);
procedure Next_ssnl (Cur : in out Scanner.Tokn_Cursor);
-- Same as Next_ss, but also skip line endings
procedure Next_ssnl (Cur : in out Scanner.Tokn_Cursor) is
use Scanner;
begin
Next (Cur);
while Kind (Cur) in Enabled_LB_Token | EOL_Token loop
Next (Cur);
end loop;
if Kind (Cur) = Spaces then
Next (Cur);
pragma Assert
(Kind (Cur) not in Enabled_LB_Token | EOL_Token | Spaces);
end if;
end Next_ssnl;
procedure Next_ss (Cur : in out Scanner.Tokn_Cursor) is
use Scanner;
begin
Next (Cur);
while Kind (Cur) = Spaces loop
Next (Cur);
end loop;
pragma Assert (Kind (Cur) not in Spaces);
end Next_ss;
function Next_ss (Cur : Scanner.Tokn_Cursor) return Scanner.Tokn_Cursor is
begin
return Result : Scanner.Tokn_Cursor := Cur do
Next_ss (Result);
end return;
end Next_ss;
procedure Prev_ss (Cur : in out Scanner.Tokn_Cursor) is
use Scanner;
begin
Prev (Cur);
if Kind (Cur) = Spaces then
Prev (Cur);
pragma Assert (Kind (Cur) /= Spaces);
end if;
end Prev_ss;
function Prev_ss (Cur : Scanner.Tokn_Cursor) return Scanner.Tokn_Cursor is
begin
return Result : Scanner.Tokn_Cursor := Cur do
Prev_ss (Result);
end return;
end Prev_ss;
subtype Symbol is Syms.Symbol;
function "=" (X, Y : Symbol) return Boolean renames Syms."=";
subtype Ada_Node is Libadalang.Analysis.Ada_Node;
use type Ada_Node;
function Is_Null (Tree : Ada_Node) return Boolean is (Tree.Is_Null);
function T_Img (Tree : Ada_Node) return String is (Tree.Image);
Op_Sym_Table : constant array (Positive range <>) of Symbol :=
[Name_Q_And,
Name_Q_Or,
Name_Q_Xor,
Name_Q_Mod,
Name_Q_Rem,
Name_Q_Abs,
Name_Q_Not];
function Is_Op_Sym_With_Letters (N : Symbol) return Boolean is
(for some Op of Op_Sym_Table => Case_Insensitive_Equal (N, Op));
-- True if N looks like a string literal that can be used as an operator
-- symbol containing letters, so case might matter. N should be in all
-- lower case.
function Sname_83 (Tok : Scanner.Tokn_Cursor) return Boolean;
-- True if Tok can be a simple_name (in Ada 83). This includes reserved
-- words that were added to the language after Ada 83. Needed because we
-- don't know which language version is being used.
function Sname_83 (Tok : Scanner.Tokn_Cursor) return Boolean is
use Scanner;
begin
return Kind (Tok) in Ident | String_Lit | Reserved_Word_New;
end Sname_83;
procedure Insert_Comment_Text
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Utils.Command_Lines.Command_Line;
Comment_Token : Scanner.Tokn_Cursor);
-- Insert the text of the comment into New_Tokns, including the initial
-- "--" and leading blanks.
-- This will eventually be replaced by Comment_Tokn_To_Buf.
procedure Append_Temp_Line_Break
(Lines_Data_P : Lines_Data_Ptr; Org : String);
function Equal_Ignoring_CR (Src_S, Out_S : Symbol) return Boolean;
-- Used in Match functions below, where the source and output tokens
-- should be identical, except that source line endings can contain
-- CR (the Windows convention).
-----------------------
-- Equal_Ignoring_CR --
-----------------------
function Equal_Ignoring_CR (Src_S, Out_S : Symbol) return Boolean is
begin
if Src_S = Out_S then
return True;
end if;
return Replace_String
(Str (Src_S).S, From => [1 => ASCII.CR], To => "")
= Str (Out_S).S;
end Equal_Ignoring_CR;
----------------
function Next_Enabled
(Lines_Data : Lines_Data_Rec;
F : Line_Break_Index_Index)
return Line_Break_Index_Index
is
All_LB : Line_Break_Vector renames Lines_Data.All_LB;
All_LBI : Line_Break_Index_Vector renames Lines_Data.All_LBI;
First : Line_Break renames All_LB (All_LBI (F));
pragma Assert (First.Enabled);
Result : Line_Break_Index_Index := F + 1;
Last : Line_Break := All_LB (All_LBI (Result));
begin
while not Last.Enabled loop
-- Add this verification to prevent, in case of partial formatting
-- mode of gnatpp, to get an exceeding value for the table index.
if Result /= Last_Index (All_LBI) then
Result := Result + 1;
Last := All_LB (All_LBI (Result));
end if;
-- In some situation when partial formatting is performed no line
-- break is enabled after the 1st one. Adding this exit condition
-- to cover this situation.
exit when Result = Last_Index (All_LBI);
end loop;
--??? pragma Assert (First.Level = Last.Level);
return Result;
end Next_Enabled;
----------------
procedure Assert_No_Trailing_Blanks (V : WChar_Vector);
-- Assert that there are no lines with trailing blanks in V, and that
-- all space characters are ' ' (e.g. no tabs), and that the last line
-- is terminated by NL.
procedure Raise_Token_Mismatch
(Message : String;
Lines_Data : Lines_Data_Rec;
Src_Buf : Buffer;
Src_Tok, Out_Tok : Scanner.Tokn_Cursor);
-- Called when either Insert_Comments_And_Blank_Lines or Final_Check finds
-- a mismatch. Prints debugging information and raises Token_Mismatch.
procedure Final_Check_Helper
(Lines_Data_P : Lines_Data_Ptr;
Src_Buf : in out Buffer;
Cmd : Utils.Command_Lines.Command_Line);
procedure Final_Check
(Lines_Data_P : Lines_Data_Ptr;
Src_Buf : in out Buffer;
Cmd : Utils.Command_Lines.Command_Line;
Pp_Off_Present : Boolean);
-- Final pass: check that we have not damaged the input source text.
-- except that comments are now included in Out_[Tokens|Buf], and this
-- checks that they match the ones in Src_Tokns. Final_Check simply
-- calls Final_Check_Helper, plus asserts that Out_Buf wasn't modified.
-- If Pp_Off_Present is True, then do not check for trailing spaces since
-- pp off regions are allowed to have them.
-- The code in Final_Check[_Helper] is parallel to the code in
-- Insert_Comments_And_Blank_Lines, so there's a bit of code duplication.
-- It is worth it to keep Final_Check[_Helper] as simple as possible. If
-- you make changes to one, consider making similar changes to the other.
function Num_Lits_Match
(Src_Tok, Out_Tok : Scanner.Tokn_Cursor;
Cmd : Utils.Command_Lines.Command_Line) return Boolean;
-- Called by the Match functions for Numeric_Literal
function Num_Lits_Match
(Src_Tok, Out_Tok : Scanner.Tokn_Cursor;
Cmd : Utils.Command_Lines.Command_Line) return Boolean
is
use Scanner;
begin
return R : Boolean do
if Text (Src_Tok) = Text (Out_Tok) then
R := True;
else
declare
Src_Tok_Text : constant W_Str := To_W_Str (Text (Src_Tok));
Out_Tok_Text : constant W_Str := To_W_Str (Text (Out_Tok));
begin
-- If we're not inserting underscores, then the tokens must be
-- identical to match. Note that if the source token already
-- contains underscores, we don't modify it.
if (Arg (Cmd, Decimal_Grouping) = 0
and then Arg (Cmd, Based_Grouping) = 0)
or else Find (Src_Tok_Text, "_") /= 0
then
R := False;
else
R := Src_Tok_Text = Replace_All (Out_Tok_Text, "_", "");
end if;
end;
end if;
end return;
end Num_Lits_Match;
procedure Assert_No_Trailing_Blanks (V : WChar_Vector) is
begin
for X in 2 .. Last_Index (V) loop
declare
C : constant W_Char := V (X);
begin
pragma Assert (if C /= ' ' then not Is_Space (C));
if C = NL then
pragma Assert (V (X - 1) /= ' ');
end if;
end;
end loop;
-- pragma Assert (Last_Element (V) = NL);
end Assert_No_Trailing_Blanks;
procedure Append_Temp_Line_Break
(Lines_Data_P : Lines_Data_Ptr; Org : String)
is
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
New_Tokns : Scanner.Tokn_Vec renames Lines_Data.New_Tokns;
Cur_Indentation : Natural renames Lines_Data.Cur_Indentation;
All_LB : Line_Break_Vector renames Lines_Data.All_LB;
Temp_LBI : Line_Break_Index_Vector renames Lines_Data.Temp_LBI;
begin
Append
(All_LB,
Line_Break'
(Tok | Tokn_Val => <>, -- Initial value not used
Hard => True,
Affects_Comments => False,
Enabled => True,
Source_Line_Breaks_Enabled => False,
Level => 1,
Indentation => Cur_Indentation,
Bin_Op_Count => 0,
Length => <>));
Append (Temp_LBI, Last_Index (All_LB));
Scanner.Lines.Append_Line_Break_Tokn
(New_Tokns, Enabled => True,
Index => Last_Index (All_LB), Org => Org);
end Append_Temp_Line_Break;
-------------------------
-- Insert_Comment_Text --
-------------------------
procedure Insert_Comment_Text
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Utils.Command_Lines.Command_Line;
Comment_Token : Scanner.Tokn_Cursor)
is
use Scanner;
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
Cur_Indentation : Natural renames Lines_Data.Cur_Indentation;
New_Tokns : Scanner.Tokn_Vec renames Lines_Data.New_Tokns;
function Filled_Text
(Comment_Tok : Tokn_Cursor;
Leading_Blanks : Natural)
return W_Str;
-- Returns the text of the comment after filling (see
-- GNATCOLL.Paragraph_Filling).
----------------
-- Filled_Text--
----------------
function Filled_Text
(Comment_Tok : Tokn_Cursor;
Leading_Blanks : Natural)
return W_Str
is
use GNATCOLL.Paragraph_Filling, Ada.Strings.Unbounded;
S1 : constant String := Str (Text (Comment_Tok)).S;
S2 : constant String :=
To_String
(Pretty_Fill
(Paragraph => S1,
Max_Line_Length =>
Arg (Cmd, Max_Line_Length) -
(Cur_Indentation + String'("--")'Length + Leading_Blanks)));
begin
return From_UTF8 (S2);
end Filled_Text;
-- Comments_Gnat_Beginning causes the comment to start with at least 2
-- blanks, unless its an empty comment which must not have leading
-- blanks.
-- This is only aplicable to Fillable_Comment or
-- Other_Whole_Line_Comment tokens that are not part of a header
-- comment.
Leading_Blanks : constant Natural :=
(if Arg (Cmd, Comments_Gnat_Beginning)
and then not Is_Header_Comment (Token_At_Cursor (Comment_Token))
and then Kind (Comment_Token) in
Fillable_Comment | Other_Whole_Line_Comment
then
(if Is_Empty_Comment (Token_At_Cursor (Comment_Token)) then 0
else Natural'Max (Scanner.Leading_Blanks (Comment_Token), 2))
else Scanner.Leading_Blanks (Comment_Token));
-- In Comments_Only mode, we need to indent "by hand" here. In normal
-- mode, Cur_Indentation will be heeded by the line breaks.
Do_Filling : constant Boolean :=
Comment_Filling_Enabled (Cmd)
and then Kind (Comment_Token) = Fillable_Comment;
Text : constant W_Str :=
(if Do_Filling then Filled_Text (Comment_Token, Leading_Blanks)
else To_W_Str (Scanner.Text (Comment_Token)));
-- Start of processing for Insert_Comment_Text
begin
Append_Comment_Text
(V => New_Tokns,
X => Comment_Token,
Tx => Text,
Recompute_Length => True,
Comments_Only => Arg (Cmd, Comments_Only),
Leading_Blanks => Leading_Blanks,
Org => "Insert_Comment_Text");
-- It would be good to avoid dealing with text here, and avoid
-- recomputing the length all the time.
end Insert_Comment_Text;
procedure Comment_Token_To_Buffer
(Buffer : in out Pp.Buffers.Buffer;
Comment_Token : Scanner.Tokn_Cursor;
Cmd : Utils.Command_Lines.Command_Line);
-- Called by Tokns_To_Buffer in the comment case, which is the most
-- complicated.
-----------------------------
-- Comment_Token_To_Buffer --
-----------------------------
procedure Comment_Token_To_Buffer
(Buffer : in out Pp.Buffers.Buffer;
Comment_Token : Scanner.Tokn_Cursor;
Cmd : Utils.Command_Lines.Command_Line)
is
use Scanner;
function Compute_Indentation
(Comment_Token : Scanner.Tokn_Cursor;
Prev_Token : Scanner.Tokn_Cursor) return W_Str;
-- This function is called only if the use-tabs switch is passed and
-- returns the proper indentation text according to the required number
-- of tabs and spaces computed based on the current sloc column value
-- of the comment token.
---------------------------
-- Compute_Indentation --
---------------------------
function Compute_Indentation
(Comment_Token : Scanner.Tokn_Cursor;
Prev_Token : Scanner.Tokn_Cursor) return W_Str
is
pragma Assert (Arg (Cmd, Use_Tabs)
and then Kind (Prev_Token) = Tab_Token);
Tab_Str : constant W_Str := To_W_Str (Text (Prev_Token));
Indent : constant Positive := Sloc_Col (Comment_Token) - 1;
-- Compute the number of tabs and spaces to get the right
-- indentation based on the indentation switch value
Tab_Size : constant Positive := PP_Indentation (Cmd);
Tabs_Nb : constant Integer := Indent / Tab_Size;
Spaces_Nb : constant Integer := Indent mod Tab_Size;
Result : Bounded_W_Str (Max_Length => Natural (Indent));
begin
if Tabs_Nb > 1 then
for I in 1 .. Tabs_Nb loop
Append (Result, Tab_Str);
end loop;
if Spaces_Nb /= 0 then
for Idx in 1 .. Spaces_Nb loop
Append (Result, ' ');
end loop;
end if;
end if;
return To_String (Result);
end Compute_Indentation;
function Filled_Text
(Comment_Token : Tokn_Cursor)
return W_Str;
-- Returns the text of the comment after filling (see
-- GNATCOLL.Paragraph_Filling).
-- Comments_Gnat_Beginning causes the comment to start with at least 2
-- blanks, unless its an empty comment which must not have leading
-- blanks.
-- This is only aplicable to Fillable_Comment or
-- Other_Whole_Line_Comment tokens that are not part of a header
-- comment.
pragma Assert
(if Arg (Cmd, Comments_Gnat_Beginning)
and then not Is_Header_Comment (Token_At_Cursor (Comment_Token))
and then Kind (Comment_Token) in
Fillable_Comment | Other_Whole_Line_Comment
then
(if Is_Empty_Comment (Token_At_Cursor (Comment_Token))
then Scanner.Leading_Blanks (Comment_Token) = 0
else Scanner.Leading_Blanks (Comment_Token) >= 2));
Prev_Tok : constant Tokn_Cursor := Prev (Comment_Token);
pragma Assert
(if Kind (Comment_Token) in Whole_Line_Comment then
(if not Arg (Cmd, Use_Tabs) then
Kind (Prev_Tok) in Spaces | EOL_Token | Line_Break_Token
else
Kind (Prev_Tok) in
Spaces | Tab_Token | EOL_Token | Line_Break_Token));
Indentation : constant W_Str :=
(if Kind (Comment_Token) in Whole_Line_Comment then
(if Kind (Prev_Tok) in Spaces then
To_W_Str (Text (Prev_Tok))
elsif Arg (Cmd, Use_Tabs)
and then Kind (Prev_Tok) = Tab_Token
then
Compute_Indentation (Comment_Token, Prev_Tok)
else "")
else "");
pragma Assert
(if Kind (Comment_Token) in Whole_Line_Comment then
(if Kind (Prev_Tok) = Spaces then
Indentation'Length = Sloc_Col (Comment_Token) - 1));
First_Line_Prelude : constant W_Str :=
"--" & [1 .. Scanner.Leading_Blanks (Comment_Token) => ' '];
-- String that precedes the comment Text (first line)
Subsequent_Prelude : constant W_Str := Indentation & First_Line_Prelude;
-- String that precedes subsequent line of the comment Text
-----------------
-- Filled_Text --
-----------------
function Filled_Text
(Comment_Token : Tokn_Cursor)
return W_Str
is
use GNATCOLL.Paragraph_Filling, Ada.Strings.Unbounded;
S1 : String renames Str (Text (Comment_Token)).S;
S2 : constant String :=
To_String
(Pretty_Fill
(S1,
Max_Line_Length =>
Arg (Cmd, Max_Line_Length) - Subsequent_Prelude'Length));
begin
return From_UTF8 (S2);
end Filled_Text;
Do_Filling : constant Boolean :=
Arg (Cmd, Comments_Only)
and then Comment_Filling_Enabled (Cmd)
and then Kind (Comment_Token) = Fillable_Comment;
Text_NL : constant W_Str :=
(if Do_Filling then Filled_Text (Comment_Token)
else To_W_Str (Scanner.Text (Comment_Token)));
pragma Assert (Text_NL (Text_NL'Last) = NL);
-- Skip last NL
Text : W_Str renames Text_NL (Text_NL'First .. Text_NL'Last - 1);
-- Start of processing for Comment_Token_To_Buffer
begin
Insert (Buffer, First_Line_Prelude);
for X in Text'Range loop
if Text (X) = NL then
Insert_NL (Buffer);
Insert (Buffer, Subsequent_Prelude);
else
Insert (Buffer, Text (X));
end if;
end loop;
end Comment_Token_To_Buffer;
procedure Tokns_To_Buffer
(Buf : in out Buffer; Tokns : Scanner.Tokn_Vec;
Cmd : Utils.Command_Lines.Command_Line)
is
use Scanner;
begin
Clear (Buf);
if not Is_Empty (Tokns) then
declare
Cur : Tokn_Cursor := Next (First (Tokns'Unrestricted_Access));
begin
-- Skip the last LB sentinel
while not After_Last (Cur) loop
if Kind (Cur) in Comment_Kind then
Comment_Token_To_Buffer (Buf, Cur, Cmd);
elsif Kind (Cur) = Tab_Token then
Insert_Tab (Buf);
else
Insert_Any (Buf, To_W_Str (Text (Cur)));
end if;
Next (Cur);
end loop;
Reset (Buf);
end;
end if;
end Tokns_To_Buffer;
----------------------
-- Do_Comments_Only --
----------------------
procedure Do_Comments_Only
(Lines_Data_P : Lines_Data_Ptr;
Src_Buf : in out Buffer;
Cmd : Utils.Command_Lines.Command_Line)
is
use Scanner;
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
Initial_Indentation : Natural renames Lines_Data.Initial_Indentation;
Cur_Indentation : Natural renames Lines_Data.Cur_Indentation;
Src_Toks : aliased Tokn_Vec;
pragma Assert (Is_Empty (Src_Toks));
Ignored : Boolean := Get_Tokns
(Src_Buf, Src_Toks,
Comments_Special_On => Arg (Cmd, Comments_Special));
Cur_Tok : Tokn_Cursor :=
Next (First (Src_Toks'Unchecked_Access)); -- skip sentinel
Saved_New_Tokns : Scanner.Tokn_Vec renames Lines_Data.Saved_New_Tokns;
New_Tokns : Scanner.Tokn_Vec renames Lines_Data.New_Tokns;
Ignore : Boolean := Move_Tokns
(Target => Saved_New_Tokns, Source => New_Tokns);
procedure Reset_Indentation;
-- Set the indentation to it's initial value (usually 0, but can be set
-- by the --initial-indentation switch.
procedure Reset_Indentation is
begin
Cur_Indentation := Initial_Indentation;
end Reset_Indentation;
-- Start of processing for Do_Comments_Only
begin
Append_Tokn (New_Tokns, Start_Of_Input);
Append_Tokn (New_Tokns, True_End_Of_Line_LF);
while Kind (Cur_Tok) /= End_Of_Input loop
if Kind (Cur_Tok) in Comment_Kind then
-- Set Cur_Indentation to the number of spaces to be inserted
-- before "--". For whole-line comments, that's one less than the
-- starting column. For end-of-line comments, it's the number of
-- blanks between the last character of the previous token to the
-- first character of this (comment) token.
case Comment_Kind'(Kind (Cur_Tok)) is
when Whole_Line_Comment =>
Cur_Indentation := Sloc (Cur_Tok).Col - 1;
when End_Of_Line_Comment =>
Cur_Indentation :=
Sloc (Cur_Tok).First - Sloc (Prev_ss (Cur_Tok)).Last - 1;
end case;
Insert_Comment_Text (Lines_Data_P, Cmd, Cur_Tok);
Reset_Indentation;
else
Append_Tokn (New_Tokns, Cur_Tok, Org => "only, other");
end if;
Next (Cur_Tok);
end loop;
Append_Tokn (New_Tokns, End_Of_Input);
Clear (Saved_New_Tokns);
Tokns_To_Buffer (Lines_Data.Out_Buf, New_Tokns, Cmd);
Final_Check (Lines_Data_P, Src_Buf, Cmd, False);
end Do_Comments_Only;
Post_Tree_Phases_Done : exception;
procedure Keyword_Casing
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line);
-- Convert reserved words to lower/upper case based on command-line
-- options.
procedure Insert_Form_Feeds
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line);
-- Insert FF after "pragma Page;" if --ff-after-pragma-page switch was
-- given. It might seem silly to have a whole extra pass for this little
-- feature, but it's a rarely used feature, so we don't care if it's a
-- little slower, and this seems cleanest. We could have put this
-- processing in some other unrelated pass. Note that it would not be
-- easy to do this in Convert_Tree_To_Ada, because the FF goes after the
-- ";", and the ";" is not printed as part of the pragma -- it goes
-- BETWEEN the pragma and whatever comes next. Furthermore, we want to
-- do this last so the FF doesn't get turned back into NL.
procedure Copy_Pp_Off_Regions
(Input : Char_Vector;
Lines_Data_P : Lines_Data_Ptr;
Pp_Off_Present : Boolean;
Cmd : Command_Line);
-- Input is the the Char_Vector with the original source. This should
-- be an immaculate copy of the source file, since pp off regions should
-- not change at all.
-- Out_Buf is fully formatted at this point, including regions where
-- pretty printing is supposed to be turned off. This replaces those
-- regions of Out_Buf with the corresponding regions of Src_Buf. Note
-- that this destroys any markers that might be pointing to Out_Buf.
procedure Keyword_Casing
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line)
is
begin
-- The usual case is Lower_Case, in which case there's nothing to do,
-- because all of the Ada_Templates have reserved words in lower case.
-- If it's Upper_Case, we loop through the tokens, converting reserved
-- words to upper case.
case PP_Keyword_Casing (Cmd) is
when Lower_Case =>
null;
when Upper_Case =>
declare
use Scanner;
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
Out_Buf : Buffer renames Lines_Data.Out_Buf;
Out_Tokns : Scanner.Tokn_Vec renames Lines_Data.Out_Tokns;
Ignored : Boolean := Get_Tokns
(Out_Buf, Out_Tokns,
Comments_Special_On => Arg (Cmd, Comments_Special));
Out_Tok : Tokn_Cursor := First (Out_Tokns'Access);
begin
Outer_Loop :
while not After_Last (Out_Tok) loop
Next_ss (Out_Tok);
Error_Sloc := To_Langkit (Sloc (Out_Tok));
loop
if Kind (Out_Tok) in Reserved_Word then
Replace_Cur (Out_Buf, To_Upper (Cur (Out_Buf)));
end if;
Move_Forward (Out_Buf);
exit Outer_Loop when At_End (Out_Buf);
-- If there are extra blank lines at the end of file,
-- then we need the At_End test.
exit when At_Point (Out_Buf, Next_Sloc_First (Out_Tok));
end loop;
end loop Outer_Loop;
Reset (Out_Buf);
Clear (Out_Tokns);
end;
end case;
end Keyword_Casing;
procedure Insert_Form_Feeds_Helper
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line);
procedure Insert_Form_Feeds
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line) is
begin
-- Ignore this switch for now. It's not clear that anyone uses it, and
-- we have much bigger issues that need fixing.
if False and then Arg (Cmd, Ff_After_Pragma_Page) then
Insert_Form_Feeds_Helper (Lines_Data_P, Cmd);
end if;
end Insert_Form_Feeds;
procedure Insert_Form_Feeds_Helper
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line)
is
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
Out_Buf : Buffer renames Lines_Data.Out_Buf;
Out_Tokns : Scanner.Tokn_Vec renames Lines_Data.Out_Tokns;
use Scanner;
Ignored : Boolean := Get_Tokns
(Out_Buf, Out_Tokns,
Comments_Special_On => Arg (Cmd, Comments_Special));
Prev_Prev_Tok : Tokn_Cursor := Next_ss (First (Out_Tokns'Access));
Prev_Tok : Tokn_Cursor := Next_ss (Prev_Prev_Tok);
Out_Tok : Tokn_Cursor := Next_ss (Prev_Tok);
-- Out_Tok skips sentinel and first 3 tokens
begin
while not At_Last (Out_Tok) loop
Error_Sloc := To_Langkit (Sloc (Out_Tok));
loop
Move_Forward (Out_Buf);
exit when At_Point (Out_Buf, Next_Sloc_First (Out_Tok));
end loop;
if Kind (Out_Tok) = ';'
and then Kind (Prev_Tok) = Ident
and then Case_Insensitive_Equal (Text (Prev_Tok), Name_Page)
and then Kind (Prev_Prev_Tok) = Res_Pragma
then
Insert_Any (Out_Buf, W_FF);
end if;
Prev_Prev_Tok := Prev_Tok;
Prev_Tok := Out_Tok;
Next_ss (Out_Tok);
end loop;
Reset (Out_Buf);
Clear (Out_Tokns);
end Insert_Form_Feeds_Helper;
procedure Copy_Pp_Off_Regions_Helper
(Input : Char_Vector;
Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line);
procedure Copy_Pp_Off_Regions
(Input : Char_Vector;
Lines_Data_P : Lines_Data_Ptr;
Pp_Off_Present : Boolean;
Cmd : Command_Line) is
begin
-- Optimize by skipping this phase if there are no Pp_Off_Comments
if Pp_Off_Present then
Copy_Pp_Off_Regions_Helper (Input, Lines_Data_P, Cmd);
end if;
end Copy_Pp_Off_Regions;
procedure Copy_Pp_Off_Regions_Helper
(Input : Char_Vector;
Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line)
is
Src_Buf : Buffer;
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
Out_Buf : Buffer renames Lines_Data.Out_Buf;
Src_Tokns : Scanner.Tokn_Vec renames Lines_Data.Src_Tokns;
Out_Tokns : Scanner.Tokn_Vec renames Lines_Data.Out_Tokns;
use Scanner;
New_Buf : Buffer;
-- Buffers don't support deletion, so we need to build up a whole new
-- Buffer. This will be moved into Out_Buf when we are done.
procedure Get_Next_Off_On
(Tok : in out Tokn_Cursor;
Expect : Pp_Off_On_Comment);
-- Get the next OFF or ON (or End_Of_Input). The token itself is
-- returned in Tok. Expect is purely for assertions; it alternates
-- between OFF and ON; Tok must be as expected (or End_Of_Input).
procedure Copy (Buf : in out Buffer; Up_To : Positive);
-- Copy from Buf to New_Buf, up to the given position
procedure Skip (Buf : in out Buffer; Up_To : Positive);
-- Move forward in Buf, up to the given position, ignoring the
-- characters.
procedure Indent_Pp_Off (Src_Tok, Out_Tok : Tokn_Cursor) with
Pre => Kind (Src_Tok) = Kind (Out_Tok)
and then Kind (Src_Tok) in Pp_Off_Comment | End_Of_Input
and then Kind (Out_Tok) in Pp_Off_Comment | End_Of_Input;
-- This is called just after copying Spaces from Out_Buf, and just
-- before copying Pp_Off_Comment from Src_Buf. This appends additional
-- spaces to New_Buf so the Pp_Off_Comment will be indented as it was in
-- Src_Buf. We don't need any such adjustment for Pp_On_Comment, because
-- indentation preceding those is copied from Src_Buf.
procedure Get_Next_Off_On
(Tok : in out Tokn_Cursor;
Expect : Pp_Off_On_Comment) is
begin
loop
Next (Tok);
Error_Sloc :=
(if Kind (Tok) in End_Of_Input then
Slocs.No_Source_Location
else To_Langkit (Scanner.Sloc (Tok)));
exit when Kind (Tok) in Expect | End_Of_Input;
end loop;
pragma Assert (Kind (Tok) in Expect | End_Of_Input);
pragma Assert
(Kind (Prev_ss (Tok)) in Start_Of_Input | EOL_Token);
end Get_Next_Off_On;
procedure Copy (Buf : in out Buffer; Up_To : Positive) is
begin
while not At_Point (Buf, Up_To) loop
Insert_Any (New_Buf, Cur (Buf));
Move_Forward (Buf);
end loop;
end Copy;
procedure Skip (Buf : in out Buffer; Up_To : Positive) is
begin
while not At_Point (Buf, Up_To) loop
Move_Forward (Buf);
end loop;
end Skip;
procedure Indent_Pp_Off (Src_Tok, Out_Tok : Tokn_Cursor) is
begin
if Kind (Out_Tok) = Pp_Off_Comment then
Insert (New_Buf,
[Sloc_Col (Out_Tok) .. Sloc_Col (Src_Tok) - 1 => ' ']);
end if;
end Indent_Pp_Off;
Ignored : Boolean := Get_Tokns
(Out_Buf, Out_Tokns,
Comments_Special_On => Arg (Cmd, Comments_Special));
Src_Tok : Tokn_Cursor;
Out_Tok : Tokn_Cursor := First (Out_Tokns'Access);
-- Start of processing for Copy_Pp_Off_Regions_Helper
begin
Clear (Src_Tokns);
-- UA21-003 : Fill Src_Buf with Input's content, including the trailing
-- spaces since trailing spaces in pp off regions should be kept.
Insert_Ada_Source
(Buf => Src_Buf,
Input =>
Utils.Char_Vectors.Char_Vectors.Elems
(Input) (1 .. Utils.Char_Vectors.Char_Vectors.Last_Index (Input)),
Wide_Character_Encoding =>
Utils.Command_Lines.Common.Wide_Character_Encoding (Cmd),
Expand_Tabs => True,
Tab_Len => (if Arg (Cmd, Use_Tabs)
then Natural (PP_Indentation (Cmd))
else 0),
Include_Trailing_Spaces => True);
-- The Src_Buf contains a sequence of zero or more OFF and ON
-- commands. The first must be OFF, then ON, then OFF and so on,
-- alternating. If that weren't true, we would have gotten an error in
-- Insert_Comments_And_Blank_Lines, in which case we don't get here.
-- The final End_Of_Input acts as an ON or OFF as appropriate.
-- The Out_Buf contains a corresponding sequence with the same
-- number of OFF's and ON's.
-- Pretty printing is ON between the beginning and the first OFF, then
-- OFF until the next ON, and so on.
Reset (Src_Buf);
-- Create a token vector out of the source buffer. This vector will
-- include trailing Space tokens.
Ignored :=
Get_Tokns
(Input => Src_Buf,
Result => Src_Tokns,
Comments_Special_On => Arg (Cmd, Comments_Special));
Src_Tok := First (Src_Tokns'Access);
-- When we see an OFF, we want to copy/ignore starting at the
-- beginning of the line on which the OFF appears, which is the
-- Prev. For an ON, we ignore the Prev.
if Debug_Mode then
Dbg_Out.Put ("Copy_Pp_Off_Regions: Src_Tokns:\n");
Put_Tokens (Src_Tokns);
Dbg_Out.Put ("end Src_Tokns:\n");
Dbg_Out.Put ("Copy_Pp_Off_Regions: Out_Tokns:\n");
Put_Tokens (Out_Tokns);
Dbg_Out.Put ("end Out_Tokns:\n");
end if;
-- The following loop repeatedly copies an ON region from Out_Buf to
-- New_Buf (ignoring the corresponding region of Src_Buf), then copies
-- an OFF region from Src_Buf to New_Buf (ignoring the corresponding
-- region of Out_Buf).
loop
Get_Next_Off_On (Out_Tok, Expect => Pp_Off_Comment);
Get_Next_Off_On (Src_Tok, Expect => Pp_Off_Comment);
Copy (Out_Buf, Up_To => Next_Sloc_First (Prev (Out_Tok)));
Skip (Src_Buf, Up_To => Next_Sloc_First (Prev (Src_Tok)));
exit when Kind (Src_Tok) = End_Of_Input;
Indent_Pp_Off (Src_Tok, Out_Tok);
Get_Next_Off_On (Out_Tok, Expect => Pp_On_Comment);
Get_Next_Off_On (Src_Tok, Expect => Pp_On_Comment);
Copy (Src_Buf, Up_To => Next_Sloc_First (Prev (Src_Tok)));
Skip (Out_Buf, Up_To => Next_Sloc_First (Prev (Out_Tok)));
-- Make sure we reach the end of both token vector at the same time
pragma Assert
((Kind (Out_Tok) = End_Of_Input) = (Kind (Src_Tok) = End_Of_Input));
exit when Kind (Src_Tok) = End_Of_Input;
end loop;
Reset (Src_Buf);
Reset (Out_Buf);
Reset (New_Buf);
Clear (Out_Tokns);
Move (Target => Out_Buf, Source => New_Buf);
end Copy_Pp_Off_Regions_Helper;
package Tok_Phases is
-- ???The plan is to implement the new phases here, and get rid of
-- Tok_Phases once it's all working.
procedure Split_Lines
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line;
First_Time : Boolean;
Partial_GNATPP : Boolean := False);
-- Enable soft line breaks as necessary to prevent too-long lines.
-- First_Time is for debugging.
procedure Enable_Line_Breaks_For_EOL_Comments
(Src_Buf : in out Buffer;
Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line;
Partial_GNATPP : Boolean := False);
-- For all end-of-line comments that occur at a soft line break, enable
-- the line break. Note that this does not modify the output.
procedure Insert_Comments_And_Blank_Lines
(Src_Buf : in out Buffer;
Messages : out Scanner.Source_Message_Vector;
Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line;
Pp_Off_Present : in out Boolean;
Partial_GNATPP : Boolean := False);
-- New_Tokns doesn't contain any comments; they are inserted into the
-- output from Src_Tokns. Blank lines are also copied from Src_Tokns to
-- New_Tokns. The output is also patched up in miscellaneous other ways,
-- such as inserting preprocessor directives (see comments in the body
-- for details).
--
-- This procedure also does some work in preparation for
-- Copy_Pp_Off_Regions. In particular, it checks that OFF/ON commands
-- are in the proper sequence, and it sets the Pp_Off_Present flag.
procedure Insert_Indentation (Lines_Data_P : Lines_Data_Ptr);
procedure Insert_Alignment
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line;
Partial_GNATPP : Boolean := False);
-- Expand tabs as necessary to align things
procedure Insert_Tabs (Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line);
-- Replace spaces by tabs instead of spaces when --use-tabs switch is
-- passed. The spaces will be replaces by tabs following the logic:
-- * use --indentation to know how many spaces a tab has
-- * when the indentation corresponds to n*tab_size use n tabs instead
-- of spaces
-- (i.e., when tab_size=3 6 spaces
-- => replaced by 2 tabs)
-- * when the indentation does not match n*tab_size, it will use a mix
-- of tab characters and normal whitespaces
-- (i.e., when tab_size=3 and 8 spaces
-- => replaced by 2 tabs and 2 spaces)
end Tok_Phases;
procedure Post_Tree_Phases
(Input : Char_Vector;
Lines_Data_P : Lines_Data_Ptr;
Messages : out Scanner.Source_Message_Vector;
Src_Buf : in out Buffer;
Cmd : Command_Line;
Partial : Boolean;
Partial_GNATPP : Boolean := False)
is
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
All_LB : Line_Break_Vector renames Lines_Data.All_LB;
All_LBI : Line_Break_Index_Vector renames Lines_Data.All_LBI;
Pp_Off_Present : Boolean := False;
-- True if there is at least one Pp_Off_Comment. We don't care about
-- Pp_On_Comments, because it's an error to have a Pp_On_Comment
-- without a preceding Pp_Off_Comment. Set True if appropriate by
-- Insert_Comments_And_Blank_Lines. This allows us to skip the
-- Copy_Pp_Off_Regions pass as an optimization.
begin
-- ????We probably want to do more, but this is for gnatstub
-- for now.
if Partial and then not Partial_GNATPP then
Clear (All_LB);
Clear (All_LBI);
Clear (Lines_Data.Tabs);
Tokns_To_Buffer (Lines_Data.Out_Buf, Lines_Data.New_Tokns, Cmd);
return;
end if;
if not Partial_GNATPP then
Tok_Phases.Split_Lines
(Lines_Data_P, Cmd,
First_Time => True);
Tok_Phases.Enable_Line_Breaks_For_EOL_Comments
(Src_Buf, Lines_Data_P, Cmd);
Tok_Phases.Insert_Comments_And_Blank_Lines
(Src_Buf, Messages, Lines_Data_P,
Cmd, Pp_Off_Present);
Tok_Phases.Split_Lines
(Lines_Data_P, Cmd,
First_Time => False);
Tok_Phases.Insert_Indentation (Lines_Data_P);
Tok_Phases.Insert_Alignment (Lines_Data_P, Cmd);
if Arg (Cmd, Use_Tabs) then
-- If the --use-tabs switch is passed then the spaces should be
-- replaced by tabs whether this is possible for each indentation,
-- otherwise a mix of tabs and spaces should be added instead of
-- the spaces composing the indentation of each line.
Tok_Phases.Insert_Tabs (Lines_Data_P, Cmd);
end if;
Tokns_To_Buffer (Lines_Data.Out_Buf, Lines_Data.New_Tokns, Cmd);
Keyword_Casing (Lines_Data_P, Cmd);
Insert_Form_Feeds (Lines_Data_P, Cmd);
Copy_Pp_Off_Regions (Input, Lines_Data_P, Pp_Off_Present, Cmd);
-- The following pass doesn't modify anything; it just checks that
-- the sequence of tokens we have constructed matches the original
-- source code (with some allowed exceptions).
Final_Check (Lines_Data_P, Src_Buf, Cmd, Pp_Off_Present);
else
-- Actions only in partial gnatpp mode. Final_Check is omitted
-- since applying for the entire file for now.
Tok_Phases.Split_Lines
(Lines_Data_P, Cmd,
First_Time => True,
Partial_GNATPP => Partial_GNATPP);
Tok_Phases.Enable_Line_Breaks_For_EOL_Comments
(Src_Buf, Lines_Data_P, Cmd, Partial_GNATPP);
Tok_Phases.Insert_Comments_And_Blank_Lines
(Src_Buf, Messages, Lines_Data_P, Cmd,
Pp_Off_Present,
Partial_GNATPP);
Tok_Phases.Split_Lines
(Lines_Data_P, Cmd,
First_Time => False,
Partial_GNATPP => Partial_GNATPP);
Tok_Phases.Insert_Indentation (Lines_Data_P);
Tok_Phases.Insert_Alignment (Lines_Data_P, Cmd, Partial_GNATPP);
if Arg (Cmd, Use_Tabs) then
-- If the --use-tabs switch is passed then the spaces should be
-- replaced by tabs whether this is possible for each indentation,
-- otherwise a mix of tabs and spaces should be added instead of
-- the spaces composing the indentation of each line.
Tok_Phases.Insert_Tabs (Lines_Data_P, Cmd);
end if;
Tokns_To_Buffer (Lines_Data.Out_Buf, Lines_Data.New_Tokns, Cmd);
Keyword_Casing (Lines_Data_P, Cmd);
end if;
exception
when Post_Tree_Phases_Done => null;
end Post_Tree_Phases;
procedure Raise_Token_Mismatch
(Message : String;
Lines_Data : Lines_Data_Rec;
Src_Buf : Buffer;
Src_Tok, Out_Tok : Scanner.Tokn_Cursor)
is
Out_Buf : Buffer renames Lines_Data.Out_Buf;
use Scanner;
subtype Q is Opt_Token_Kind with
Predicate => Q in Nil | Spaces | Start_Of_Input | End_Of_Input |
EOL_Token | Line_Break_Token;
function Txt (Tok : Tokn_Cursor) return String is
(if Kind (Tok) in Q then "``" & Str (Text (Tok)).S & "''"
else Str (Text (Tok)).S);
-- Text to print. Put quotes around some kinds.
-- Start of processing for Raise_Token_Mismatch
begin
Error_Sloc := To_Langkit (Sloc (Src_Tok));
if Enable_Token_Mismatch then
Utils.Dbg_Out.Output_Enabled := True;
Err_Out.Put ("Src_Buf:\n");
Dump_Buf (Src_Buf);
Err_Out.Put ("Out_Buf:\n");
Dump_Buf (Out_Buf);
Err_Out.Put
("\1: Token mismatch: \2 --> \3\n",
Message, Txt (Src_Tok), Txt (Out_Tok));
Err_Out.Put ("Src tokens:\n");
Put_Tokens (Highlight => Src_Tok);
Err_Out.Put ("========================================\n");
Err_Out.Put ("Out tokens:\n");
Put_Tokens (Highlight => Out_Tok);
end if;
raise Token_Mismatch;
end Raise_Token_Mismatch;
------------------------
-- Final_Check_Helper --
------------------------
procedure Final_Check_Helper
(Lines_Data_P : Lines_Data_Ptr;
Src_Buf : in out Buffer;
Cmd : Utils.Command_Lines.Command_Line)
is
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
Out_Buf : Buffer renames Lines_Data.Out_Buf;
Src_Tokns : Scanner.Tokn_Vec renames Lines_Data.Src_Tokns;
Out_Tokns : Scanner.Tokn_Vec renames Lines_Data.Out_Tokns;
use Scanner;
function Match (Src_Tok, Out_Tok : Tokn_Cursor) return Boolean;
-- Similar to Match in Insert_Comments_And_Blank_Lines, but here we need
-- to deal with comments.
procedure Collect_Comments
(Tok : in out Tokn_Cursor; Result : in out WChar_Vector);
-- Collect up all the text of a sequence of Whole_Line_Comments,
-- ignoring changes made by paragraph filling. Paragraph_Filling might
-- have changed blank to NL and vice versa, and it turns a series of
-- blanks into a single one. Similarly needed if Comments_Gnat_Beginning
-- is True.
function Match (Src_Tok, Out_Tok : Tokn_Cursor) return Boolean is
begin
if Arg (Cmd, Spaces_Only) then
return Kind (Src_Tok) = Kind (Out_Tok)
and then Case_Insensitive_Equal (Text (Src_Tok), Text (Out_Tok));
end if;
return R : Boolean do
if Kind (Src_Tok) = Kind (Out_Tok) then
case Kind (Src_Tok) is
when EOL_Token | Spaces | Line_Break_Token =>
raise Program_Error;
when Start_Of_Input | End_Of_Input |
Tab_Token | Other_Lexeme | Illegal_Character =>
pragma Assert
(Equal_Ignoring_CR (Text (Src_Tok), Text (Out_Tok)));
R := True;
when Reserved_Word =>
pragma Assert
(Case_Insensitive_Equal
(Text (Src_Tok), Text (Out_Tok)));
R := True;
when Ident =>
R := Case_Insensitive_Equal
(Text (Src_Tok), Text (Out_Tok));
when Numeric_Literal =>
R := Num_Lits_Match (Src_Tok, Out_Tok, Cmd);
when Character_Literal =>
R := Text (Src_Tok) = Text (Out_Tok);
when String_Lit =>
if Is_Op_Sym_With_Letters (Text (Src_Tok)) then
R := Case_Insensitive_Equal
(Text (Src_Tok), Text (Out_Tok));
else
R := Text (Src_Tok) = Text (Out_Tok);
end if;
when Preprocessor_Directive =>
R := Text (Src_Tok) = Text (Out_Tok);
when Comment_Kind =>
R :=
(Arg (Cmd, Comments_Gnat_Beginning)
or else Leading_Blanks (Src_Tok) =
Leading_Blanks (Out_Tok))
and then Text (Src_Tok) = Text (Out_Tok);
end case;
elsif Kind (Src_Tok) in Reserved_Word_New
and then Kind (Out_Tok) = Ident
then
R := Case_Insensitive_Equal (Text (Src_Tok), Text (Out_Tok));
elsif Kind (Src_Tok) = End_Of_Line_Comment
and then Kind (Out_Tok) in Whole_Line_Comment
then
R := Text (Src_Tok) = Text (Out_Tok)
and then
(if
not Arg (Cmd, Comments_Gnat_Beginning)
then
Leading_Blanks (Src_Tok) = Leading_Blanks (Out_Tok));
-- ???This case will be needed if/when we turn end-of-line
-- comments that don't fit into whole-line comments. That
-- transformation seems questionable, because it would
-- damage idempotency: first run of gnatpp turns an
-- end-of-line comment into a whole-line-comment, and then a
-- second run considers it part of a comment paragraph and
-- fills it.
else
R := False;
end if;
end return;
end Match;
Ignored : Boolean := Get_Tokns
(Out_Buf, Out_Tokns,
Comments_Special_On => Arg (Cmd, Comments_Special));
Src_Tok : Tokn_Cursor := Next_ss (First (Src_Tokns'Access));
Out_Tok : Tokn_Cursor := Next_ss (First (Out_Tokns'Access));
-- Cursors into Src_Tokns and Out_Tokns, respectively. Skip the
-- first Start_Of_Input token, which is just a sentinel.
procedure Collect_Comments
(Tok : in out Tokn_Cursor;
Result : in out WChar_Vector)
is
begin
while Kind (Tok) in Whole_Line_Comment loop
declare
Text : constant W_Str := To_W_Str (Scanner.Text (Tok));
function White (X : Positive) return Boolean is
(X <= Text'Last
and then
(Is_Space (Text (X))
or else Is_Line_Terminator (Text (X))));
-- True if X points to a space or NL character
pragma Assert
(Text'First = 1
and then Text'Last >= 1
and then (if Text'Last > 1 then not White (1))
and then White (Text'Last));
X : Positive := 1;
begin
while X <= Text'Last loop
if White (X) then
Append (Result, ' ');
while White (X) loop
X := X + 1;
end loop;
else
Append (Result, Text (X));
X := X + 1;
end if;
end loop;
end;
loop
Next_ss (Tok);
exit when Kind (Tok) not in EOL_Token;
end loop;
-- When --use-tabs switch is passed some tabs might be present
-- at the beginning of a comment line, so go through them to get
-- the next real token kind. This is needed when multiline
-- comments needs to be handled.
if Arg (Cmd, Use_Tabs) and then Kind (Tok) = Tab_Token then
loop
Next (Tok);
exit when Kind (Tok) /= Tab_Token;
end loop;
end if;
end loop;
end Collect_Comments;
-- Start of processing for Final_Check_Helper
begin
-- Skip initial EOL_Token token
pragma Assert (Kind (Out_Tok) in EOL_Token);
Next_ss (Out_Tok);
-- This loop is similar to the one in
-- Insert_Comments_And_Blank_Lines; see that for commentary.
loop
Error_Sloc := To_Langkit (Scanner.Sloc (Src_Tok));
if Simulate_Token_Mismatch and then Get_Tokn_Index (Src_Tok) > 6 then
-- Simulate a token mismatch, for testing
Raise_Token_Mismatch
("Final_Check 0", Lines_Data, Src_Buf, Src_Tok, Out_Tok);
end if;
-- Spaces_Only requires an exact match, except for Spaces
if Arg (Cmd, Spaces_Only) then
if Match (Src_Tok, Out_Tok) then
exit when Kind (Src_Tok) = End_Of_Input;
-- i.e. exit when both Src and Out are at end of input
Next (Src_Tok);
Next (Out_Tok);
while Kind (Src_Tok) = Spaces loop
Next (Src_Tok);
end loop;
while Kind (Out_Tok) = Spaces loop
Next (Out_Tok);
end loop;
else
Raise_Token_Mismatch
("Final_Check 1", Lines_Data, Src_Buf, Src_Tok, Out_Tok);
end if;
else
if Kind (Src_Tok) not in EOL_Token
and then
(Match (Src_Tok, Out_Tok)
or else (Kind (Src_Tok) = '!' and then Kind (Out_Tok) = '|'))
then
exit when Kind (Src_Tok) = End_Of_Input;
-- i.e. exit when both Src and Out are at end of input
Next_ss (Src_Tok);
Next_ss (Out_Tok);
else
-- If we're filling comments, then the comments might not match
-- up. For example, a line break could be added such that the
-- first line is too short to be considered part of a fillable
-- comment paragraph, thus turning one comment into two. So we
-- collect them all together and check that their text
-- more-or-less matches.
--
-- Similarly, we do this if Comments_Gnat_Beginning. For
-- example, if one comment starts with a single blank and the
-- next starts with two, then they will not look like a single
-- paragraph during Insert_Comments_And_Blank_Lines, but here
-- they will, because an extra blank has been added to the
-- first.
--
-- Actually, we need to do this in any case: if two comments in
-- the input are not indented the same, they will be indented
-- the same in the output, and thus appear to be a fillable
-- paragraph.
if Kind (Src_Tok) in Whole_Line_Comment
and then Kind (Out_Tok) in Whole_Line_Comment
then
declare
Src_Comments : WChar_Vector;
Out_Comments : WChar_Vector;
begin
Collect_Comments (Src_Tok, Src_Comments);
Collect_Comments (Out_Tok, Out_Comments);
if Src_Comments /= Out_Comments then
if Enable_Token_Mismatch then
Err_Out.Put
("\1 --> \2\n",
To_UTF8 (To_Array (Src_Comments)),
To_UTF8 (To_Array (Out_Comments)));
end if;
Raise_Token_Mismatch
("Final_Check 2",
Lines_Data, Src_Buf, Src_Tok, Out_Tok);
end if;
end;
-- Check for "end;" --> "end Some_Name;" case
elsif Kind (Src_Tok) = ';'
and then
Kind (Prev_Lexeme (Src_Tok)) = Res_End
and then Sname_83 (Out_Tok)
then
loop -- could be "end A.B.C;"
Next_ssnl (Out_Tok);
exit when Kind (Out_Tok) /= '.';
Next_ssnl (Out_Tok);
if not Sname_83 (Out_Tok) then
Raise_Token_Mismatch
("Final_Check 3",
Lines_Data, Src_Buf, Src_Tok, Out_Tok);
end if;
end loop;
if Kind (Out_Tok) /= ';' then
Raise_Token_Mismatch
("Final_Check 4",
Lines_Data, Src_Buf, Src_Tok, Out_Tok);
end if;
elsif Kind (Src_Tok) in EOL_Token then
Next_ss (Src_Tok);
elsif Kind (Out_Tok) in EOL_Token | Tab_Token then
Next_ss (Out_Tok);
-- Else print out debugging information and crash. This avoids
-- damaging the source code in case of bugs.
else
Raise_Token_Mismatch
("Final_Check 5", Lines_Data, Src_Buf, Src_Tok, Out_Tok);
end if;
end if;
end if;
end loop;
pragma Assert (At_Beginning (Out_Buf));
-- We didn't touch Out_Buf, other than to get the tokens from it
if not At_Last (Src_Tok) or else not At_Last (Out_Tok) then
Raise_Token_Mismatch
("Final_Check 6", Lines_Data, Src_Buf, Src_Tok, Out_Tok);
end if;
Clear (Out_Tokns);
end Final_Check_Helper;
-----------------
-- Final_Check --
-----------------
procedure Final_Check
(Lines_Data_P : Lines_Data_Ptr;
Src_Buf : in out Buffer;
Cmd : Utils.Command_Lines.Command_Line;
Pp_Off_Present : Boolean)
is
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
begin
if Disable_Final_Check then
return;
end if;
-- In Dev mode, we have Enable_Token_Mismatch, which prints debugging
-- information on a mismatch.
if Enable_Token_Mismatch then
declare
Old_Out_Buf : constant WChar_Vector :=
To_Vector (Lines_Data.Out_Buf);
begin
Final_Check_Helper (Lines_Data_P, Src_Buf, Cmd);
declare
Out_Buf : constant WChar_Vector :=
To_Vector (Lines_Data.Out_Buf);
begin
pragma Assert (Out_Buf = Old_Out_Buf);
-- There might exist trailing spaces in pp off regions
if not Pp_Off_Present then
pragma Debug (Assert_No_Trailing_Blanks (Out_Buf));
end if;
end;
end;
-- In production mode, we don't print debugging information, but we
-- still raise the exception.
else
Final_Check_Helper (Lines_Data_P, Src_Buf, Cmd);
end if;
end Final_Check;
----------------
-- Debugging:
package Enable_Dbg_Out is
-- Declaring an object of type Enable_Dbg_Out causes Dbg_Out to be
-- enabled, and then restored to its previous state on finalization.
use Ada.Finalization;
type Enable_Dbg_Out is new Limited_Controlled with record
Old : Boolean;
end record;
procedure Initialize (X : in out Enable_Dbg_Out);
procedure Finalize (X : in out Enable_Dbg_Out);
end Enable_Dbg_Out;
package body Enable_Dbg_Out is
procedure Initialize (X : in out Enable_Dbg_Out) is
begin
X.Old := Utils.Dbg_Out.Output_Enabled;
Utils.Dbg_Out.Output_Enabled := True;
end Initialize;
procedure Finalize (X : in out Enable_Dbg_Out) is
begin
Utils.Dbg_Out.Output_Enabled := X.Old;
end Finalize;
end Enable_Dbg_Out;
procedure Put_All_Tokens (Message : String; Lines_Data : Lines_Data_Rec) is
use Scanner, Dbg_Out;
Dummy : Enable_Dbg_Out.Enable_Dbg_Out;
begin
if Debug_Flag_4 then
Dbg_Out.Output_Enabled := True;
Put ("\n\1\n", Message);
Put ("Src_Tokns:\n");
Put_Tokens (Lines_Data.Src_Tokns);
Put ("New_Tokns:\n");
Put_Tokens (Lines_Data.New_Tokns);
Dbg_Out.Output_Enabled := False;
end if;
pragma Assert (Is_Empty (Lines_Data.Out_Tokns));
pragma Assert (Is_Empty (Lines_Data.Saved_New_Tokns));
end Put_All_Tokens;
function Line_Text
(Lines_Data : Lines_Data_Rec;
F, L : Line_Break_Index_Index) return W_Str
is
Out_Buf : Buffer renames Lines_Data.Out_Buf;
All_LB : Line_Break_Vector renames Lines_Data.All_LB;
All_LBI : Line_Break_Index_Vector renames Lines_Data.All_LBI;
First : constant Line_Break := All_LB (All_LBI (F));
Last : constant Line_Break := All_LB (All_LBI (L));
use Scanner;
Result : constant W_Str :=
Slice (Out_Buf, Sloc_First (First.Tok), Sloc_First (Last.Tok));
begin
return Result (Result'First + 1 .. Result'Last);
end Line_Text;
function Tab_Image (Tabs : Tab_Vector; X : Tab_Index) return String is
Tab : constant Tab_Rec := Tabs (X);
begin
return "Tabs(" &
Image (Integer (X)) &
") = ^" &
Image (Integer (Tab.Index_In_Line)) &
Str (Tab.Token).S &
ASCII.HT &
" at " &
(if Tab.Col = Positive'Last
then ""
else " Col = " & Image (Tab.Col)) &
(if Tab.Num_Blanks = 0 then ""
else " Blanks = " & Image (Tab.Num_Blanks)) &
(if Tab.Is_Fake then " FAKE" else "") &
(if Is_Null (Tab.Tree)
then ""
else "(Tr = " & T_Img (Tab.Tree) & ")") &
(if Is_Null (Tab.Parent) then ""
else "(Pa = " & T_Img (Tab.Parent) & ")");
end Tab_Image;
procedure Put_Line_Break (Break : Line_Break) is
Dummy : Enable_Dbg_Out.Enable_Dbg_Out;
use Dbg_Out;
begin
Put
("\1, \2, \3",
String'(1 .. Break.Indentation => '_'),
(if Break.Hard then "hard" else "soft"),
(if Break.Enabled then "enabled" else "disabled"));
Scanner.Put_Token (Break.Tok);
end Put_Line_Break;
procedure Put_LBs (LB_Vec : Line_Break_Vector) is
Dummy : Enable_Dbg_Out.Enable_Dbg_Out;
use Dbg_Out;
begin
if Is_Empty (LB_Vec) then
Put ("empty Line_Break_Vector\n");
end if;
for LBI in 1 .. Last_Index (LB_Vec) loop
Put ("\1 => ", Image (Integer (LBI)));
Put_Line_Break (LB_Vec (LBI));
end loop;
end Put_LBs;
procedure Put_LBIs (LBI_Vec : Line_Break_Index_Vector) is
Dummy : Enable_Dbg_Out.Enable_Dbg_Out;
use Dbg_Out;
begin
if Is_Empty (LBI_Vec) then
Put ("empty Line_Break_Index_Vector\n");
end if;
for LBII in 1 .. Last_Index (LBI_Vec) loop
declare
LBI : constant Line_Break_Index := LBI_Vec (LBII);
begin
Put ("\1 => \2\n",
Image (Integer (LBII)), Image (Integer (LBI)));
end;
end loop;
end Put_LBIs;
procedure Put_Line_Breaks (Lines_Data : Lines_Data_Rec) is
Dummy : Enable_Dbg_Out.Enable_Dbg_Out;
All_LB : Line_Break_Vector renames Lines_Data.All_LB;
All_LBI : Line_Break_Index_Vector renames Lines_Data.All_LBI;
L : Line_Break_Index_Index;
Line_Num : Natural := 0; -- only counts enabled lines
use Dbg_Out;
begin
Put
("Last_Index (All_LBI) = \1\n",
Image (Integer (Last_Index (All_LBI))));
for Cur_Line in 1 .. Last_Index (All_LBI) loop
if All_LB (All_LBI (Cur_Line)).Enabled then
Line_Num := Line_Num + 1;
end if;
Put
("\1:\t\2\3",
Image (Line_Num),
String'(1 .. All_LB (All_LBI (Cur_Line)).Indentation => '_'),
(if All_LB (All_LBI (Cur_Line)).Enabled then "" else "?"));
Put (" lev=\1", Image (Integer (All_LB (All_LBI (Cur_Line)).Level)));
-- if False then
-- Put ("\t\1", Image (All_LB (All_LBI (Cur_Line)).Kind));
-- end if;
if All_LB (All_LBI (Cur_Line)).Enabled
and then Cur_Line /= Last_Index (All_LBI)
then
L := Next_Enabled (Lines_Data, Cur_Line);
Put
("\t\1..\2 len=\3",
Image (Integer (Cur_Line)),
Image (Integer (L)),
Image (All_LB (All_LBI (Cur_Line)).Length));
-- ???Line_Text doesn't work, because Out_Buf isn't set yet, so
-- disable this for now. It would be better to reconstruct the
-- text from the tokens.
if False then
Put ("\t<<\1>>", To_UTF8 (Line_Text (Lines_Data, Cur_Line, L)));
end if;
end if;
Put ("\n");
end loop;
for Cur_Line in 1 .. Last_Index (All_LBI) loop
Put_Line_Break (All_LB (All_LBI (Cur_Line)));
end loop;
end Put_Line_Breaks;
procedure Format_Debug_Output
(Lines_Data : Lines_Data_Rec; Message : String)
is
Out_Buf : Buffer renames Lines_Data.Out_Buf;
Tabs : Tab_Vector renames Lines_Data.Tabs;
use Dbg_Out;
begin
if not Dbg_Out.Output_Enabled then
return;
end if;
Text_IO.Flush (Text_IO.Standard_Output);
Text_IO.Flush (Text_IO.Standard_Error);
Put ("\n\nFormat_Debug_Output: \1:\n", Message);
Dump_Buf (Out_Buf);
Put_Line_Breaks (Lines_Data);
for X in 1 .. Last_Index (Tabs) loop
Put ("\1\n", Tab_Image (Tabs, X));
end loop;
Text_IO.Flush (Text_IO.Standard_Error);
Text_IO.Flush (Text_IO.Standard_Output);
end Format_Debug_Output;
procedure Assert_No_LB (Lines_Data : Lines_Data_Rec) is
begin
pragma Assert (Is_Empty (Lines_Data.All_LB));
pragma Assert (Is_Empty (Lines_Data.All_LBI));
pragma Assert (Is_Empty (Lines_Data.Temp_LBI));
pragma Assert (Is_Empty (Lines_Data.Enabled_LBI));
pragma Assert (Is_Empty (Lines_Data.Syntax_LBI));
end Assert_No_LB;
procedure Put_Char_Vector (Container : Char_Vector) is
procedure Put_Between is null;
begin
Utils.Char_Vectors.Char_Vectors.Put
(Container, Utils.Formatted_Output.Put_Char'Access,
Put_Between'Access);
end Put_Char_Vector;
package Wide_Formatted_Output is new Utils.Generic_Formatted_Output
(Char_Type => W_Char,
Str_Type => W_Str,
Basic_Put_Char => Wide_Text_IO_Put_Char);
procedure Put_WChar_Vector (Container : WChar_Vector) is
procedure Put_Between is null;
use Wide_Formatted_Output;
begin
Put (Container, Put_Char'Access, Put_Between'Access);
end Put_WChar_Vector;
function LB_Tok (LB : Line_Break) return Scanner.Tokn_Cursor is
use Scanner;
begin
pragma Assert (Kind (LB.Tok) in Line_Break_Token);
pragma Assert (Token_At_Cursor (LB.Tok) = LB.Tokn_Val);
return LB.Tok;
end LB_Tok;
package body Tok_Phases is
pragma Style_Checks ("M82"); -- because these will eventually be unnested
use Scanner, Scanner.Lines;
function Line_Len
(All_LB : Line_Break_Vector; F, L : Line_Break_Index)
return Natural;
-- F and L are the first and last index forming a line; returns the
-- length of the line, not counting new-lines. F must be enabled.
function Forms_Blank_Line
(All_LB : Line_Break_Vector;
F, L : Line_Break_Index) return Boolean;
-- True if F..L forms an empty line (or would, if both were enabled).
procedure Collect_Line_Breaks
(Lines_Data_P : Lines_Data_Ptr;
Tokns : in out Scanner.Tokn_Vec;
Do_All, Do_Enabled, Do_Syntax, First_Time : Boolean);
-- Collect line breaks from New_Tokns, ignoring soft line breaks that
-- would form blank lines. These ignored ones are also removed from
-- New_Tokns. Set the Tok of each line break to point to the
-- corresponding line break token in Tokns. Note that these will become
-- invalid as soon as Tokns is modified. Set All_LBI, Enabled_LBI, and
-- Syntax_LBI, as appropriate.
procedure Erase_LB_Toks (All_LB : in out Line_Break_Vector);
-- Set the Tok of each line break to Nil
function Forms_Blank_Line
(All_LB : Line_Break_Vector;
F, L : Line_Break_Index) return Boolean
is
First : Line_Break renames All_LB (F);
Last : Line_Break renames All_LB (L);
FP : Positive := Sloc_First (LB_Tok (First));
LP : constant Positive := Sloc_First (LB_Tok (Last));
begin
-- Take into account the fact that a hard line break occupies one
-- character (the NL), whereas a soft line break does not, and the fact
-- that a soft line break can be preceded or followed by a single blank
-- (but not both).
if First.Hard then
FP := FP + 1;
end if;
if FP < LP and then Kind (Next (LB_Tok (First))) = Spaces then
pragma Assert (Text (Next (LB_Tok (First))) = Name_Space);
FP := FP + 1;
end if;
pragma Assert (FP <= LP);
return FP = LP;
end Forms_Blank_Line;
procedure Collect_Line_Breaks
(Lines_Data_P : Lines_Data_Ptr;
Tokns : in out Scanner.Tokn_Vec;
Do_All, Do_Enabled, Do_Syntax, First_Time : Boolean)
is
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
All_LB : Line_Break_Vector renames Lines_Data.All_LB;
All_LBI : Line_Break_Index_Vector renames Lines_Data.All_LBI;
Enabled_LBI : Line_Break_Index_Vector renames Lines_Data.Enabled_LBI;
Syntax_LBI : Line_Break_Index_Vector renames Lines_Data.Syntax_LBI;
Saved_New_Tokns : aliased Scanner.Tokn_Vec;
Ignore : Boolean := Move_Tokns
(Target => Saved_New_Tokns, Source => Tokns);
pragma Assert (not Is_Empty (Saved_New_Tokns));
P : Tokn_Cursor := First (Saved_New_Tokns'Unchecked_Access);
-- token preceding Tok
pragma Assert (Kind (P) = Start_Of_Input);
Tok : Tokn_Cursor := Next (P);
begin
Clear (All_LBI);
pragma Assert (Is_Empty (Lines_Data.Temp_LBI));
Clear (Enabled_LBI);
Clear (Syntax_LBI);
while not After_Last (Tok) loop
if Kind (P) in Line_Break_Token then
pragma Assert
(not (Kind (Prev (Tok)) = Spaces and then Kind (Tok) = Spaces));
declare
LBI : constant Line_Break_Index :=
Line_Break_Token_Index (P);
LB : Line_Break renames All_LB (LBI);
begin
Append_Tokn (Tokns, P);
LB.Tok := Last (Tokns'Unrestricted_Access);
LB.Tokn_Val := Token_At_Cursor (LB.Tok);
-- We don't want soft line breaks to form blank lines, so
-- we discard them if they would. The first line break is
-- enabled, so we're not calling Last_Element on an empty
-- All_LBI.
if LB.Enabled
or else not First_Time
or else not Forms_Blank_Line
(All_LB, Last_Element (All_LBI), LBI)
then
if Do_All then
Append (All_LBI, LBI);
end if;
if LB.Enabled then
if All_LB (LBI).Hard
and then (All_LB (LBI).Length /= 0
or else LBI = Last_Index (All_LB))
then
if Do_Syntax then
Append (Syntax_LBI, LBI);
end if;
end if;
if Do_Enabled then
Append (Enabled_LBI, LBI);
end if;
end if;
else
Delete_Last (Tokns);
-- It was appended above
end if;
end;
else
Append_Tokn (Tokns, P);
end if;
P := Tok;
Next (Tok);
end loop;
pragma Assert (Kind (P) = End_Of_Input);
Append_Tokn (Tokns, P);
pragma Debug (Check_Same_Tokens
(Tokns, Saved_New_Tokns,
"Collect_Line_Breaks", "Tokns", "Saved_New_Tokns"));
end Collect_Line_Breaks;
procedure Erase_LB_Toks (All_LB : in out Line_Break_Vector) is
begin
if not Assert_Enabled then
return;
end if;
for LB of All_LB loop
LB.Tok := Nil_Tokn_Cursor;
end loop;
end Erase_LB_Toks;
function Line_Len
(All_LB : Line_Break_Vector; F, L : Line_Break_Index)
return Natural
is
pragma Assert (All_LB (F).Enabled);
First : Line_Break renames All_LB (F);
Last : Line_Break renames All_LB (L);
F_Pos : constant Natural := Sloc_First (Next (LB_Tok (First)));
L_Pos : constant Natural := Sloc_First (LB_Tok (Last));
Leading_Blank : constant Natural :=
(if not First.Hard
and then L_Pos > F_Pos + 1
and then Kind (Next (LB_Tok (First))) = Spaces
then 1
else 0);
-- The test for First.Hard above is needed in the annoying
-- Extra_Blank_On_Return case, among others.
Trailing_Blank : constant Natural :=
(if L_Pos > F_Pos + 2 and then Kind (Prev (LB_Tok (Last))) = Spaces
then 1
else 0);
Without_Indent : constant Natural :=
L_Pos - F_Pos - Leading_Blank - Trailing_Blank;
-- The length without the indentation is just the difference between
-- the positions, except that if the first or last character is ' '
-- adjacent to a soft line break, it doesn't count.
begin
-- If the line is blank, we ignore the indentation; we won't be
-- putting blanks in the output. Otherwise, the length is the
-- indentation plus the length without the indentation as
-- calculated above.
return
(if Without_Indent = 0 then 0
else First.Indentation + Without_Indent);
end Line_Len;
-----------------
-- Split_Lines --
-----------------
procedure Split_Lines
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line;
First_Time : Boolean;
Partial_GNATPP : Boolean := False)
is
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
First_Line_Offset : Natural renames Lines_Data.First_Line_Offset;
Initial_Indentation : Natural renames Lines_Data.Initial_Indentation;
All_LB : Line_Break_Vector renames Lines_Data.All_LB;
All_LBI : Line_Break_Index_Vector renames
Lines_Data.All_LBI;
New_Tokns : Scanner.Tokn_Vec renames Lines_Data.New_Tokns;
function Worthwhile_Line_Break
(F, X : Line_Break_Index) return Boolean;
-- Called for X = the first so-far-disabled line break on a line.
-- Returning False means don't bother enabling it. F is the previous
-- one.
procedure Assertions;
-- Assert that the line Length has been set if and only if the line
-- break is enabled.
procedure Assertions is
begin
for X in 1 .. Last_Index (All_LBI) loop
declare
Break : Line_Break renames All_LB (All_LBI (X));
begin
if X = Last_Index (All_LBI) then
pragma Assert (Break.Enabled and then Break.Length = 0);
elsif Break.Enabled then
pragma Assert
(Break.Length =
Line_Len
(All_LB, All_LBI (X),
All_LBI (Next_Enabled (Lines_Data, X))));
else
pragma Assert (Break.Length = Natural'Last);
end if;
end;
end loop;
end Assertions;
function Worthwhile_Line_Break
(F, X : Line_Break_Index) return Boolean
is
This : constant Positive := Sloc_First (LB_Tok (All_LB (X)));
Prev : Positive := Sloc_First (LB_Tok (All_LB (F)));
Threshold : constant Positive := PP_Indent_Continuation (Cmd);
begin
if All_LB (F).Hard then
Prev := Prev + 1; -- skip NL
end if;
-- If we have something like:
-- P (...
-- there's no point in turning it into:
-- P
-- (...
-- assuming PP_Cont_Line_Indentation = 2, because it doesn't shorten
-- any lines. If the procedure name is slightly longer than "P":
-- Proc (...
-- there's _probably_ no point in turning it into:
-- Proc
-- (...
-- because it only saves 3 characters, so we will probably have
-- to split up the "..." parameters anyway.
if This - Prev <= Threshold then
return False;
end if;
return True;
end Worthwhile_Line_Break;
F : Line_Break_Index_Index := 1;
L : Line_Break_Index_Index;
Len : Natural;
Level : Nesting_Level;
More_Levels : Boolean;
Again : constant String :=
(if First_Time then "first time" else "again");
LB : Line_Break_Index_Vector;
-- All line breaks for a given line that are at the same level,
-- plus an extra one at the end that is already enabled.
First_Line : Boolean := True;
Offset : Natural := Initial_Indentation + First_Line_Offset;
-- Start of processing for Split_Lines
begin
if Arg (Cmd, Source_Line_Breaks) then
return;
end if;
pragma Debug
(Format_Debug_Output
(Lines_Data, "before Split_Lines " & Again));
Collect_Line_Breaks
(Lines_Data_P, New_Tokns,
Do_All => True, Do_Enabled => False, Do_Syntax => False,
First_Time => First_Time);
if False then
-- ???For debugging, always split at optional newlines
for Line_Index in 1 .. Last_Index (All_LBI) loop
All_LB (All_LBI (Line_Index)).Enabled := True;
end loop;
return;
end if;
while F /= Last_Index (All_LBI) loop -- through line breaks
Level := 1;
More_Levels := True;
loop -- through levels
L := Next_Enabled (Lines_Data, F);
Len :=
Line_Len (All_LB, All_LBI (F), All_LBI (L)) + Offset;
exit when Len <= Arg (Cmd, Max_Line_Length); -- short enough
exit when not More_Levels; -- no more line breaks to enable
More_Levels := False;
Clear (LB);
-- Collect line breaks at current level into LB, along with an
-- additional one so we can always do LB (X + 1) below.
for X in F + 1 .. L - 1 loop
if All_LB (All_LBI (X)).Level > Level then
More_Levels := True;
elsif All_LB (All_LBI (X)).Level = Level then
Append (LB, All_LBI (X));
end if;
end loop;
Append (LB, All_LBI (L));
declare
FF : Line_Break_Index := All_LBI (F);
LL : Line_Break_Index;
Prev_LL : Line_Break_Index;
begin
-- Loop through line breaks at current level
for X in 1 .. Last_Index (LB) - 1 loop
LL := LB (X);
Prev_LL := LL;
pragma Assert (All_LB (LL).Level = Level);
-- Don't enable the first one, unless it's "worthwhile"
-- according to the heuristic.
if LL = All_LBI (F + 1)
and then not Worthwhile_Line_Break (All_LBI (F), LL)
then
null;
-- If the line is too long, enable this soft line
-- break. In --no-compact mode, if one line break is
-- enabled, we enable all line breaks at the same nesting
-- level, except that we don't do that within binary
-- operators.
elsif Line_Len (All_LB, FF, LB (X + 1))
+ Offset
> Arg (Cmd, Max_Line_Length)
or else (not Arg (Cmd, Compact)
and then All_LB (LL).Bin_Op_Count = 0)
then
pragma Assert (not All_LB (LL).Enabled);
if First_Line then
First_Line := False;
Offset := @ - First_Line_Offset;
end if;
All_LB (LL).Enabled := True;
All_LB (LL).Affects_Comments := True;
-- Keep the indentation level of the previous LL if
-- the threshold between the two values is 1
-- (this could be the case of the split line when
-- one or more than one paranthesis are present on the
-- same level having soft line breaks associated)
if Prev_LL /= LL
and then not All_LB (Prev_LL).Enabled
and then All_LB (Prev_LL).Indentation
= All_LB (LL).Indentation - 1
then
All_LB (LL).Indentation :=
All_LB (LL).Indentation - 1;
end if;
FF := LL;
end if;
end loop; -- through line breaks at current level
end;
Level := Level + 1;
end loop; -- through levels
All_LB (All_LBI (F)).Length := Len;
pragma Assert
(All_LB (All_LBI (F)).Length
= Line_Len (All_LB, All_LBI (F),
All_LBI (Next_Enabled (Lines_Data, F)))
+ Offset);
F := L;
end loop; -- through line breaks
All_LB (All_LBI (F)).Length := 0; -- last line
pragma Debug
(Format_Debug_Output
(Lines_Data, "after Split_Lines " & Again));
-- In case of partial reformatting of an enum type makes that the
-- last LB is not always enabled. This is why this assertion will
-- fail.
if not Partial_GNATPP then
pragma Debug (Assertions);
end if;
end Split_Lines;
procedure Enable_Line_Breaks_For_EOL_Comments
(Src_Buf : in out Buffer;
Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line;
Partial_GNATPP : Boolean := False)
is
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
All_LB : Line_Break_Vector renames Lines_Data.All_LB;
All_LBI : Line_Break_Index_Vector renames Lines_Data.All_LBI;
Src_Tokns : Scanner.Tokn_Vec renames Lines_Data.Src_Tokns;
New_Tokns : Scanner.Tokn_Vec renames Lines_Data.New_Tokns;
function Match (Src_Tok, Out_Tok : Tokn_Cursor) return Boolean;
-- True if the tokens have the same kind and same text, except that the
-- matching is case insensitive for identifiers, reserved words, and
-- string literals that could be operator symbols. The source locations
-- are ignored.
function Looking_At_Paren_Or_Comma (Break : Line_Break) return Boolean;
-- True if we're look at '(' or ',', skipping any Disabled_LB_Tokens
-- and Spaces tokens.
procedure Do_End_Of_Line_Comment;
-- Found an End_Of_Line_Comment; enable line breaks as appropriate.
procedure Move_Past_Out_Tok;
function Match (Src_Tok, Out_Tok : Tokn_Cursor) return Boolean is
begin
if Debug_Mode then
Dbg_Out.Output_Enabled := True;
Dbg_Out.Put
("match ""\1"", ""\2"" ? ",
Str (Text (Src_Tok)).S, Str (Text (Out_Tok)).S);
end if;
return R : Boolean do
if Kind (Src_Tok) = Kind (Out_Tok) then
case Kind (Src_Tok) is
when Line_Break_Token | Tab_Token | EOL_Token | Spaces |
Comment_Kind | Preprocessor_Directive =>
raise Program_Error;
when Start_Of_Input | End_Of_Input | Other_Lexeme |
Illegal_Character =>
pragma Assert
(Equal_Ignoring_CR (Text (Src_Tok), Text (Out_Tok)));
R := True;
when Reserved_Word =>
pragma Assert
(Case_Insensitive_Equal
(Text (Src_Tok), Text (Out_Tok)));
R := True;
when Ident =>
R := Case_Insensitive_Equal
(Text (Src_Tok), Text (Out_Tok));
when Numeric_Literal =>
R := Num_Lits_Match (Src_Tok, Out_Tok, Cmd);
when Character_Literal =>
R := Text (Src_Tok) = Text (Out_Tok);
when String_Lit =>
if Is_Op_Sym_With_Letters (Text (Src_Tok)) then
R := Case_Insensitive_Equal
(Text (Src_Tok), Text (Out_Tok));
else
R := Text (Src_Tok) = Text (Out_Tok);
end if;
end case;
-- Allow, for example, reserved word "interface" to match
-- identifier "INTERFACE".
elsif Kind (Src_Tok) in Reserved_Word_New
and then Kind (Out_Tok) = Ident
then
R := Case_Insensitive_Equal (Text (Src_Tok), Text (Out_Tok));
else
R := False;
end if;
if Debug_Mode then
Dbg_Out.Put ("\1\n", (if R then "yes" else "No!"));
end if;
end return;
end Match;
Src_Tok : Tokn_Cursor := Next_ss (First (Src_Tokns'Access));
New_Tok : Tokn_Cursor := Next_ss (First (New_Tokns'Access));
-- Cursors into Src_Tokns and New_Tokns, respectively. Skip the
-- first Start_Of_Input token, which is just a sentinel.
Last_LB : Tokn_Cursor := First (New_Tokns'Access);
-- Last encountered line-break token
New_Cur_Line : Line_Break_Index_Index := 1;
procedure Move_Past_Out_Tok is
begin
while Kind (New_Tok) in Tab_Token loop
Next (New_Tok);
end loop;
Next (New_Tok);
while Kind (New_Tok) in Disabled_LB_Token | Tab_Token | Spaces loop
if Kind (New_Tok) = Disabled_LB_Token then
Last_LB := New_Tok;
New_Cur_Line := New_Cur_Line + 1;
pragma Assert
(Insert_Blank_Lines (Cmd)
or else LB_Tok (All_LB (All_LBI (New_Cur_Line))) =
New_Tok);
end if;
Next (New_Tok);
end loop;
if Kind (New_Tok) = Enabled_LB_Token then
Last_LB := New_Tok;
New_Cur_Line := New_Cur_Line + 1;
pragma Assert
(Insert_Blank_Lines (Cmd)
or else LB_Tok (All_LB (All_LBI (New_Cur_Line))) = New_Tok);
end if;
end Move_Past_Out_Tok;
function Looking_At_Paren_Or_Comma (Break : Line_Break) return Boolean is
T : Tokn_Cursor := LB_Tok (Break);
begin
while Kind (T) in Disabled_LB_Token | Spaces loop
Next (T);
end loop;
return Kind (T) in '(' | ',';
end Looking_At_Paren_Or_Comma;
procedure Do_End_Of_Line_Comment is
LB : Line_Break renames All_LB (All_LBI (New_Cur_Line));
begin
-- If an end-of-line comment appears at a place where there is a
-- soft line break, we enable that line break. We also enable
-- previous line breaks that are at the same level, or that belong
-- to '('. We stop when we see an enabled line break.
pragma Assert
(if Kind (Last_LB) /= Start_Of_Input then
(Sloc_First (LB_Tok (LB)) = Sloc_First (Last_LB)) =
(LB_Tok (LB) = Last_LB));
if LB_Tok (LB) = Last_LB then
for Break in reverse 1 .. New_Cur_Line loop
declare
Prev_LB : Line_Break renames All_LB (All_LBI (Break));
begin
exit when Prev_LB.Enabled;
if Prev_LB.Level = LB.Level
or else
(Prev_LB.Level < LB.Level
and then Looking_At_Paren_Or_Comma (Prev_LB))
then
Prev_LB.Enabled := True;
Prev_LB.Affects_Comments := True;
end if;
end;
end loop;
end if;
Next_ss (Src_Tok);
end Do_End_Of_Line_Comment;
Qual_Nesting : Natural := 0;
-- Count the nesting level of qualified expressions containing aggregates
-- with extra parentheses.
-- Start of processing for Enable_Line_Breaks_For_EOL_Comments
begin
if Arg (Cmd, Source_Line_Breaks) then
return;
end if;
pragma Debug
(Format_Debug_Output
(Lines_Data, "before Enable_Line_Breaks_For_EOL_Comments"));
-- Skip initial EOL_Token token
pragma Assert (Kind (New_Tok) = Enabled_LB_Token);
Next_ss (New_Tok);
-- This loop is similar to the one in
-- Insert_Comments_And_Blank_Lines; see that for commentary.
loop
Error_Sloc := To_Langkit (Scanner.Sloc (Src_Tok));
if Kind (Src_Tok) not in EOL_Token
and then
(Match (Src_Tok, New_Tok)
or else (Kind (Src_Tok) = '!' and then Kind (New_Tok) = '|'))
then
exit when Kind (Src_Tok) = End_Of_Input;
-- i.e. exit when both Src and Out are at end of input
Move_Past_Out_Tok;
Next_ss (Src_Tok);
else
-- Check for "end;" --> "end Some_Name;" case
if Kind (Src_Tok) = ';'
and then
Kind (Prev_Lexeme (Src_Tok)) = Res_End
and then Sname_83 (New_Tok)
then
loop -- could be "end A.B.C;"
Move_Past_Out_Tok;
exit when Kind (New_Tok) /= '.';
Move_Past_Out_Tok;
pragma Assert (Sname_83 (New_Tok));
end loop;
pragma Assert
(Disable_Final_Check or else
Kind (Src_Tok) in ';' | EOL_Token | Comment_Kind);
-- Check for "end Some_Name;" --> "end;" case. This only happens
-- when the --no-end-id switch was given. Here, the name was
-- present in the source, so we insert it.
elsif not Arg (Cmd, End_Id)
and then Kind (New_Tok) = ';'
and then
Kind (Prev_Lexeme (New_Tok)) = Res_End
and then Kind (Src_Tok) in Ident | String_Lit
then
loop -- could be "end A.B.C;"
Next_ss (Src_Tok);
exit when Kind (Src_Tok) /= '.';
Next_ss (Src_Tok);
pragma Assert
(Kind (Src_Tok) in Ident | String_Lit);
end loop;
pragma Assert
(Disable_Final_Check or else
Kind (Src_Tok) in ';' | EOL_Token | Comment_Kind);
-- Check for "private end" --> "end" case, with a possible
-- comment between "private" and "end".
elsif Kind (Src_Tok) = Res_Private
and then Kind (New_Tok) = Res_End
then
pragma Assert
(Disable_Final_Check
or else Kind (Next_Lexeme (Src_Tok)) = Res_End);
Next_ss (Src_Tok);
-- Check for "T'((X, Y, Z))" --> "T'(X, Y, Z)" case
elsif Kind (Src_Tok) = '('
and then Kind (Prev_Lexeme (Src_Tok)) = '('
--???Also check that the one before that is a tick!
then
Qual_Nesting := Qual_Nesting + 1;
Next_ss (Src_Tok);
elsif Qual_Nesting > 0
and then Kind (Src_Tok) = ')'
and then Kind (Prev_Lexeme (Src_Tok)) = ')'
then
Qual_Nesting := Qual_Nesting - 1;
Next_ss (Src_Tok);
elsif Kind (Src_Tok) = End_Of_Line_Comment then
Do_End_Of_Line_Comment;
elsif Kind (Src_Tok) in EOL_Token then
Next_ss (Src_Tok);
elsif Kind (Src_Tok) in Whole_Line_Comment then
Next_ss (Src_Tok);
elsif Kind (New_Tok) in Line_Break_Token then
Move_Past_Out_Tok;
elsif Kind (Src_Tok) = Preprocessor_Directive then
Next (Src_Tok);
elsif Disable_Final_Check then
Next_ss (Src_Tok);
if At_Last (Src_Tok) then
goto Done;
end if;
else
-- Partial mode formatting specific tokens synchronisations
-- where no token mismatch is supposed to be raised
if Partial_GNATPP then
if Kind (Src_Tok) = ';'
and then Kind (Prev (Src_Tok)) in
Res_End | Res_Record | Res_Loop | Ident
| Res_Tagged | Res_Abstract | Res_Null
| Numeric_Literal | String_Lit | ')'
and then Kind (New_Tok) = End_Of_Input
then
Next_ss (Src_Tok);
else
-- When enter here mostly an infinite loop situation
-- is detected in partial mode
raise Partial_GNATPP_Error;
end if;
else
Raise_Token_Mismatch
("eol_comments", Lines_Data, Src_Buf, Src_Tok, New_Tok);
end if;
end if;
end if;
end loop;
pragma Assert (At_Last (Src_Tok));
pragma Assert (At_Last (New_Tok));
<> null;
pragma Assert (Disable_Final_Check or else Qual_Nesting = 0);
pragma Assert (At_Beginning (Src_Buf));
end Enable_Line_Breaks_For_EOL_Comments;
procedure Insert_Comments_And_Blank_Lines
(Src_Buf : in out Buffer;
Messages : out Scanner.Source_Message_Vector;
Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line;
Pp_Off_Present : in out Boolean;
Partial_GNATPP : Boolean := False)
is
pragma Assert (not Pp_Off_Present); -- initialized by caller
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
Initial_Indentation : Natural renames Lines_Data.Initial_Indentation;
Cur_Indentation : Natural renames Lines_Data.Cur_Indentation;
All_LB : Line_Break_Vector renames Lines_Data.All_LB;
Temp_LBI : Line_Break_Index_Vector renames
Lines_Data.Temp_LBI;
Enabled_LBI : Line_Break_Index_Vector renames
Lines_Data.Enabled_LBI;
Syntax_LBI : Line_Break_Index_Vector renames
Lines_Data.Syntax_LBI;
Src_Tokns : Scanner.Tokn_Vec renames Lines_Data.Src_Tokns;
Saved_New_Tokns : Scanner.Tokn_Vec renames
Lines_Data.Saved_New_Tokns;
procedure Reset_Indentation;
-- Set the indentation to it's initial value (usually 0, but can be set
-- by the --initial-indentation switch.
function Match (Src_Tok, Out_Tok : Tokn_Cursor) return Boolean;
-- True if the tokens have the same kind and same text, except that the
-- matching is case insensitive for identifiers, reserved words, and
-- string literals that could be operator symbols. The source locations
-- are ignored.
procedure New_To_Newer (Expect : Opt_Token_Kind := Nil);
-- Copy New_Tok to New_Tokns, and move New_Tok one forward in
-- Saved_New_Tokns. If Expect is not Nil, then New_Tok should be of
-- that kind.
procedure Insert_End_Of_Line_Comment;
-- Found an End_Of_Line_Comment comment; copy it to the buffer. If it
-- is too long to fit on the line, turn it into a Whole_Line_Comment,
-- taking care to indent.
-- Note that the Subtree_To_Ada pass already inserted indentation, so
-- we mostly keep the indentation level at zero. The exception is
-- comments, which Subtree_To_Ada didn't see. For comments, we
-- temporarily set the indentation to that of the surrounding code.
procedure Insert_Whole_Line_Comment;
-- Found a Whole_Line_Comment; copy it to the output, taking care to
-- indent.
procedure Insert_Preprocessor_Directive;
-- Found a Preprocessor_Directive; copy it to the output, preserving
-- its indentation.
procedure Insert_Private;
-- If a private part has no declarations, the earlier passes don't
-- insert "private", whether or not it was in the source code. If
-- there is a comment, this re-inserts "private" before the comment,
-- to avoid messing up the formatting.
function LB_Needs_To_Be_Enabled (Src_Tok : Tokn_Cursor) return Boolean;
function LB_Needs_To_Be_Enabled (Src_Tok : Tokn_Cursor) return Boolean
is
begin
return
Kind (Src_Tok) in Other_Whole_Line_Comment | Fillable_Comment
and then Kind (Prev_ss (Src_Tok)) in True_End_Of_Line
and then
(Kind (Prev (Prev_ss (Src_Tok))) in ',' | Res_Is
or else Kind (Prev (Prev_ss (Src_Tok))) = End_Of_Line_Comment
or else
(Kind (Prev (Prev_ss (Src_Tok))) in True_End_Of_Line
and then
Kind (Prev
(Prev (Prev_ss (Src_Tok)))) = End_Of_Line_Comment));
end LB_Needs_To_Be_Enabled;
procedure Reset_Indentation is
begin
Cur_Indentation := Initial_Indentation;
end Reset_Indentation;
function Match (Src_Tok, Out_Tok : Tokn_Cursor) return Boolean is
begin
if Debug_Mode then
Dbg_Out.Output_Enabled := True;
Dbg_Out.Put
("match ""\1"", ""\2"" ? ",
Str (Text (Src_Tok)).S, Str (Text (Out_Tok)).S);
end if;
return R : Boolean do
if Kind (Src_Tok) = Kind (Out_Tok) then
case Kind (Src_Tok) is
when EOL_Token | Spaces | Comment_Kind |
Preprocessor_Directive | Line_Break_Token =>
raise Program_Error;
when Start_Of_Input | End_Of_Input |
Tab_Token | Other_Lexeme | Illegal_Character =>
pragma Assert
(Equal_Ignoring_CR (Text (Src_Tok), Text (Out_Tok)));
R := True;
when Reserved_Word =>
pragma Assert
(Case_Insensitive_Equal
(Text (Src_Tok), Text (Out_Tok)));
R := True;
when Ident =>
R := Case_Insensitive_Equal
(Text (Src_Tok), Text (Out_Tok));
when Numeric_Literal =>
R := Num_Lits_Match (Src_Tok, Out_Tok, Cmd);
when Character_Literal =>
R := Text (Src_Tok) = Text (Out_Tok);
when String_Lit =>
if Is_Op_Sym_With_Letters (Text (Src_Tok)) then
R := Case_Insensitive_Equal
(Text (Src_Tok), Text (Out_Tok));
else
R := Text (Src_Tok) = Text (Out_Tok);
end if;
end case;
elsif Kind (Src_Tok) in Reserved_Word_New
and then Kind (Out_Tok) = Ident
then
R := Case_Insensitive_Equal (Text (Src_Tok), Text (Out_Tok));
else
R := False;
end if;
if Debug_Mode then
Dbg_Out.Put ("\1\n", (if R then "yes" else "No!"));
end if;
end return;
end Match;
New_Tokns : Scanner.Tokn_Vec renames Lines_Data.New_Tokns;
Ignore : Boolean := Move_Tokns
(Target => Saved_New_Tokns, Source => New_Tokns);
-- After Collect_Line_Breaks below, the Tok field of each line break
-- will point into Saved_New_Tokns.
Src_Tok : Tokn_Cursor := Next_ss (First (Src_Tokns'Access));
New_Tok : Tokn_Cursor := Next_ss (First (Saved_New_Tokns'Access));
-- Cursors into Src_Tokns and Out_Tokns, respectively. Skip the
-- first Start_Of_Input token, which is just a sentinel.
Start_Line_Src_Tok : Tokn_Cursor := First (Src_Tokns'Access);
-- Token at the beginning of the previous line, but never a comment
function Before_Indentation return Natural;
-- Same as "All_LB (Syntax_LBI (Cur_Line - 1)).Indentation", except
-- we skip Syntax_LBI with Affects_Comments = False. In other
-- words, this is the previous line-breaks indentation which should
-- affect comments.
function Prev_Indentation_Affect_Comments return Boolean;
-- Will return True if the last line-breaks indentation affect
-- comments (i.e., Syntax_LBI Affects_Comments = True).
function After_Indentation return Natural;
-- Same as "All_LB (Syntax_LBI (Cur_Line)).Indentation", except we
-- skip Syntax_LBI with Affects_Comments = False. In other words,
-- this is the current/next line-breaks indentation which should
-- affect comments.
function L_Paren_Indent_For_Preserve return Natural;
-- Returns the last parenthesis indent of the stack
procedure Update_L_Paren_Indent_For_Preserve (Indent : Natural);
-- Update last paren indentation to Indentation
procedure Manage_Paren_Stack;
-- Paren_Stack (below) is a stack containing one entry for each left
-- parenthesis that has not yet been closed by a right parenthesis.
-- Indent is the additional amount to indent to get to one past just
-- under the "(".
--
-- ???This is currently used only for --preserve-line-breaks mode.
-- We could Consider using it also for the "extra" indent by 1
-- character mentioned in PP.Actions (see type Ada_Template), and
-- also for Qual_Nesting.
New_Line_Start_Out : Tokn_Cursor :=
Next (First (Saved_New_Tokns'Access));
-- Used only in --preserve-line-breaks mode. The first token on the
-- current line in Out_Tokns. Since Split_Lines has not yet been run,
-- there is no indentation present in the output.
type Paren_Stack_Index is new Positive;
type Paren_Stack_Element is record
Indent : Natural;
end record;
type Paren_Stack_Element_Array is
array (Paren_Stack_Index range <>) of Paren_Stack_Element;
package Paren_Vectors is new Utils.Vectors
(Paren_Stack_Index,
Paren_Stack_Element,
Paren_Stack_Element_Array);
Paren_Stack : Paren_Vectors.Vector;
use Paren_Vectors;
-- Enabled_LBI are the line breaks used for indenting end-of-line
-- comments. Syntax_LBI are the ones used for indenting whole-line
-- comments. Enabled_Cur_Line and Syntax_Cur_Line index into those,
-- respectively.
Enabled_Cur_Line : Line_Break_Index_Index := 1;
Syntax_Cur_Line : Line_Break_Index_Index := 1;
Prev_New_Tok : Tokn_Cursor := First (Saved_New_Tokns'Access);
-- Used by Manage_Paren_Stack to avoid pushing/popping the same paren
-- twice.
procedure Manage_Paren_Stack is
Crt_Indent : Natural := 0;
begin
if New_Tok = Prev_New_Tok then
return;
end if;
Prev_New_Tok := New_Tok;
-- We push the stack for "(" and pop for ")".
if Kind (New_Tok) = '(' then
-- Add 2 extra spaces to indent at the first character position
-- inside the parenthesis
Crt_Indent :=
Sloc (New_Tok).First - Sloc (New_Line_Start_Out).First + 2;
Push (Paren_Stack, (Indent => Crt_Indent));
elsif Kind (New_Tok) = ')' then
Pop (Paren_Stack);
end if;
end Manage_Paren_Stack;
function L_Paren_Indent_For_Preserve return Natural is
begin
if Is_Empty (Paren_Stack) then
return 0;
else
return Last_Element (Paren_Stack).Indent;
end if;
end L_Paren_Indent_For_Preserve;
procedure Update_L_Paren_Indent_For_Preserve (Indent : Natural)
is
pragma Assert (not Is_Empty (Paren_Stack));
begin
Pop (Paren_Stack);
Push (Paren_Stack, (Indent => Indent + 1));
end Update_L_Paren_Indent_For_Preserve;
Pending_Tokns : aliased Tokn_Vec;
-- Disabled_LB_Token, Tab_Token, and Spaces tokens are saved here, so
-- they can be output later. Spaces need to be deferred, because we
-- might need to insert tokens before them. Disabled_LB_Token and
-- Tab_Token need to be deferred because they might be adjacent to
-- Spaces, and we don't want them to get out of order.
procedure New_To_Newer (Expect : Opt_Token_Kind := Nil) is
begin
pragma Assert (if Expect /= Nil then Kind (New_Tok) = Expect);
declare
Pending : Tokn_Cursor :=
Next (First (Pending_Tokns'Unchecked_Access));
begin
while not After_Last (Pending) loop
Append_Tokn (New_Tokns, Pending, Org => "Pending");
Next (Pending);
end loop;
Clear (Pending_Tokns);
Append_Tokn (Pending_Tokns, Start_Of_Input);
end;
pragma Assert (Kind (New_Tok) not in EOL_Token);
if Kind (New_Tok) in Line_Break_Token
and then All_LB (Line_Break_Token_Index (New_Tok)).Enabled
then
-- Step past Syntax_LBI at the current position
while Syntax_Cur_Line <= Last_Index (Syntax_LBI)
and then Sloc_First (New_Tok) >=
Sloc_First (LB_Tok (All_LB (Syntax_LBI (Syntax_Cur_Line))))
loop
Syntax_Cur_Line := Syntax_Cur_Line + 1;
end loop;
-- Step past Enabled_LBI at the current position, taking care
-- to avoid going past the end.
while Enabled_Cur_Line < Last_Index (Enabled_LBI)
and then Sloc_First (New_Tok) >=
Sloc_First (LB_Tok (All_LB (Enabled_LBI (Enabled_Cur_Line))))
loop
Enabled_Cur_Line := Enabled_Cur_Line + 1;
end loop;
-- If the Source_Line_Breaks switch was given, and we have
-- something like "is begin" (with no line break in the
-- source), then we need to insert a Space to avoid turning it
-- into the identifier "isbegin".
if Arg (Cmd, Source_Line_Breaks)
and then not All_LB (Line_Break_Token_Index (New_Tok))
.Source_Line_Breaks_Enabled
then
if Tokens_Require_Space
(Last (New_Tokns'Access), Next_Lexeme (New_Tok))
then
Append_Spaces (New_Tokns, Count => 1);
end if;
elsif Kind (Last (New_Tokns'Access)) in Line_Break_Token
and then All_LB (Line_Break_Token_Index
(Last (New_Tokns'Access))).Enabled
then
pragma Assert
(Kind (Last (New_Tokns'Access)) not in Disabled_LB_Token);
if Kind (Prev (Last (New_Tokns'Access))) in Comment_Kind
and then not Arg (Cmd, Source_Line_Breaks)
then
null; -- Append_Temp_Line_Break already put one
else
if not Is_Blank_Line (Last (New_Tokns'Access))
or else Preserve_Blank_Lines (Cmd)
or else Arg (Cmd, Source_Line_Breaks)
then
Append_Tokn
(New_Tokns, New_Tok, Org => "New_To_Newer 1");
end if;
end if;
else
Append_Tokn (New_Tokns, New_Tok, Org => "New_To_Newer 2");
end if;
else
Append_Tokn (New_Tokns, New_Tok, Org => "New_To_Newer 3");
end if;
Next (New_Tok);
while Kind (New_Tok) in Disabled_LB_Token | Tab_Token | Spaces loop
Append_Tokn (Pending_Tokns, New_Tok);
Next (New_Tok);
end loop;
end New_To_Newer;
procedure Insert_End_Of_Line_Comment is
-- In partial formatting mode we can have only one line selected
-- and an end of line comment contained in it.
pragma Assert (Enabled_Cur_Line > 1);
function New_Space_NL return Boolean;
-- True if we should move past a space that is immediately
-- followed by a new line.
function New_Space_NL return Boolean is
begin
if Get_Num_Tokens (Pending_Tokns) < 3 then
return False;
end if;
pragma Assert
(Kind (Last (Pending_Tokns'Unchecked_Access)) =
Kind (Prev (New_Tok)));
pragma Assert
(Kind (Prev (Last (Pending_Tokns'Unchecked_Access))) =
Kind (Prev (Prev (New_Tok))));
declare
Pending_Space : constant Boolean :=
Kind (Prev (Prev (New_Tok))) = Spaces;
At_LB : constant Boolean :=
Kind (Prev (New_Tok)) = Disabled_LB_Token
or else Kind (Prev (New_Tok)) = Tab_Token;
begin
return Pending_Space and At_LB;
end;
end New_Space_NL;
Prev_LB : Line_Break renames
All_LB (Enabled_LBI (Enabled_Cur_Line - 1));
LB : Line_Break renames All_LB (Enabled_LBI (Enabled_Cur_Line));
Indentation : constant Natural := Prev_LB.Indentation;
New_Prev_Src_Tok : constant Tokn_Cursor := Prev (Src_Tok);
New_Preceding_Blanks : Natural :=
(if Kind (New_Prev_Src_Tok) = Spaces then
Tokn_Length (Prev (Src_Tok))
else 0);
-- Number of blanks between the previous token and this comment.
-- Note that tab characters have been expanded into spaces in
-- Src_Buf.
-- Start of procedding for Insert_End_Of_Line_Comment
begin
-- If we're just before a blank followed by NL, move past the blank,
-- so we won't add a new NL below.
if New_Space_NL then
pragma Assert (New_Preceding_Blanks > 0);
New_Preceding_Blanks := New_Preceding_Blanks - 1;
-- Remove the Spaces token (which must exist) from
-- Pending_Tokns.
declare
New_Pending_Tokns : Tokn_Vec;
Pending : Tokn_Cursor := First (Pending_Tokns'Unchecked_Access);
Spaces_Found : Boolean := False;
begin
while not After_Last (Pending) loop
if Kind (Pending) = Spaces then
pragma Assert (Tokn_Length (Pending) = 1);
Spaces_Found := True;
else
Append_Tokn (New_Pending_Tokns, Pending,
Org => "Pending for comment");
end if;
Next (Pending);
end loop;
pragma Assert (Spaces_Found);
Pending_Tokns := New_Pending_Tokns;
end;
Append_Spaces (New_Tokns, Count => 1);
end if;
Append_Spaces
(New_Tokns, Count => New_Preceding_Blanks, Existing_OK => True);
Insert_Comment_Text (Lines_Data_P, Cmd, Src_Tok);
-- In the usual case, the end-of-line comment is at a natural
-- hard line break, like this:
--
-- X := X + 1; -- Increment X
--
-- so we don't want another one. Likewise, if
-- Enable_Line_Breaks_For_EOL_Comments enabled a natural
-- soft line break, as in:
--
-- type Enum is
-- (Red, -- soft line break enabled here
-- ...);
--
-- we don't want another one. But if the original was:
--
-- procedure P ( -- strange place for a comment
--
-- we need to add a line break after the comment.
declare
At_Tok : Boolean := False;
begin
if Get_Num_Tokens (Pending_Tokns) >= 3 then
At_Tok := Kind (Prev (Prev (New_Tok))) = Disabled_LB_Token
and then Kind (Prev (New_Tok)) = Spaces
and then LB_Tok (LB) = Prev (Prev (New_Tok));
end if;
if LB_Tok (LB) = Prev (New_Tok)
or else LB_Tok (LB) = New_Tok
then
At_Tok := True;
end if;
if At_Tok then
Append_Tokn (New_Tokns, False_End_Of_Line, "eol extra");
-- This is needed because every comment in New_Tokns must be
-- followed by EOL_Token.
else
pragma Assert
(if Kind (New_Tok) = Disabled_LB_Token then
not All_LB (Line_Break_Token_Index (New_Tok)).Enabled);
if Kind (New_Tok) = Enabled_LB_Token then
declare
This_LB : Line_Break renames
All_LB (Line_Break_Token_Index (New_Tok));
begin
Append_Spaces (New_Tokns, Count => This_LB.Indentation);
end;
-- Avoid inserting an extra line break if we're just past a
-- line break followed by spaces. This happens for soft line
-- breaks, e.g. a comment on an enumeration literal
-- specification.
elsif Kind (Prev (New_Tok)) = Spaces
and then Kind (Prev (Prev (New_Tok))) in Line_Break_Token
then
if Insert_Blank_Lines (Cmd)
and then Kind (New_Tok) = Ident
and then Kind (Prev_ss (New_Tok)) = Disabled_LB_Token
and then Kind (Prev (Prev_ss (New_Tok))) = Res_Is
then
-- Handling something like
-- subtype My_Subtype is -- Some EOL comment
-- Mode range Some_Value_A .. Some_Value_B;
-- In this case the disabled LB token is not enabled.
-- So, enabling it here.
All_LB (Line_Break_Token_Index
(Prev_ss (New_Tok))).Enabled := True;
end if;
else
if Kind (New_Tok) = Ident
and then Kind (Prev (New_Tok)) = '('
then
-- Handling the situation where EOL comment follows '('
-- or "is" keyword
-- (i.e., the situations like
-- function X
-- (-- some EOL comment here
-- V1,
-- ...) return Boolean
--
-- Taking the last LB position for the indentation
-- level for the parameters and adjust '(' position in
-- Paren_Stack if needed
declare
Crt_Indent : Integer := LB.Indentation + 1;
begin
if Arg (Cmd, Par_Threshold) = 0 then
Crt_Indent := Crt_Indent - 1;
end if;
Cur_Indentation := Crt_Indent;
if L_Paren_Indent_For_Preserve /= Crt_Indent
then
Update_L_Paren_Indent_For_Preserve
(Crt_Indent - 2);
end if;
end;
else
-- Allign on the previous LB indentation level
Cur_Indentation := Indentation;
end if;
if not Arg (Cmd, Source_Line_Breaks) then
Append_Temp_Line_Break
(Lines_Data_P,
Org =>
"Append_Temp_ in Insert_End_Of_Line_Comment");
end if;
Reset_Indentation;
end if;
end if;
end;
Next_ss (Src_Tok);
end Insert_End_Of_Line_Comment;
Pp_On : Boolean := True;
-- True initially, and if the most recently encountered Pp_Off_Comment
-- or Pp_On_Comment was Pp_On_Comment.
Last_Pp_Off_On : Tokn_Cursor := First (Src_Tokns'Access);
-- If > First, this points to the most recently encountered
-- Pp_Off_Comment or Pp_On_Comment in Src_Tokns. Used to check for
-- errors; they must alternate, OFF, ON, OFF, ....
function Before_Indentation return Natural is
X : Line_Break_Index_Index :=
(if Syntax_Cur_Line = 1 then 1 else Syntax_Cur_Line - 1);
begin
while X > 1 and then
not All_LB (Syntax_LBI (X)).Affects_Comments
loop
X := X - 1;
end loop;
return All_LB (Syntax_LBI (X)).Indentation;
end Before_Indentation;
function Prev_Indentation_Affect_Comments return Boolean is
X : constant Line_Break_Index_Index :=
(if Syntax_Cur_Line = 1 then 1 else Syntax_Cur_Line - 1);
begin
return (X > 1 and then All_LB (Syntax_LBI (X)).Affects_Comments);
end Prev_Indentation_Affect_Comments;
function After_Indentation return Natural is
X : Line_Break_Index_Index := Syntax_Cur_Line;
begin
while X < Last_Index (Syntax_LBI)
and then not All_LB (Syntax_LBI (X)).Affects_Comments
loop
X := X + 1;
end loop;
if X <= Last_Index (Syntax_LBI) then
return All_LB (Syntax_LBI (X)).Indentation;
else
pragma Assert (Arg (Cmd, Source_Line_Breaks)
or else Partial_GNATPP);
return 0;
end if;
end After_Indentation;
-------------------------------
-- Insert_Whole_Line_Comment --
-------------------------------
procedure Insert_Whole_Line_Comment is
Indentation : Natural;
Corrected_Indentation : Natural := 0;
function Look_Before return Boolean;
-- True if we should look before the current location to determine
-- indentation level for the comment. If the next lexeme is
-- "begin", for example, we want to indent to the level of
-- "begin", even though there is probably previous code more
-- deeply indented.
procedure Set_Cur_Indentation;
-- Set Cur_Indentation as appropriate
-----------------
-- Look_Before --
-----------------
function Look_Before return Boolean is
begin
if Kind (New_Tok) = End_Of_Input then
return True;
end if;
-- If we have a comment lined up with the preceding line, with
-- no blank lines in between, then we try to keep it lined up,
-- even if "begin" (etc) follows.
pragma Assert
(Sloc (Start_Line_Src_Tok).Line < Sloc (Src_Tok).Line);
if Sloc (Start_Line_Src_Tok).Line = Sloc (Src_Tok).Line - 1
and then Sloc (Start_Line_Src_Tok).Col = Sloc (Src_Tok).Col
then
return True;
end if;
return Kind (New_Tok) not in
Res_Begin | Res_Else | Res_Elsif | Res_When;
end Look_Before;
-------------------------
-- Set_Cur_Indentation --
-------------------------
procedure Set_Cur_Indentation is
begin
if Kind (Src_Tok) in
Special_Comment | Pp_Off_Comment | Pp_On_Comment
or else Arg (Cmd, Comments_Unchanged)
then
-- Keep as in input
Cur_Indentation := Sloc (Src_Tok).Col - 1;
else
Cur_Indentation := Indentation;
end if;
end Set_Cur_Indentation;
function Next_Is_Action (Tok : Tokn_Cursor) return Boolean is
(not After_Last (Next (Tok))
and then Kind (Next (Tok)) in
Res_Procedure | Res_Function | Res_Overriding);
function Next_Is_Identifier (Tok : Tokn_Cursor) return Boolean is
(not After_Last (Next (Tok))
and then Kind (Next (Tok)) in Ident);
function Next_Is_Type (Tok : Tokn_Cursor) return Boolean is
(not After_Last (Next (Tok))
and then Kind (Next (Tok)) = Res_Type);
function Next_Is_Begin (Tok : Tokn_Cursor) return Boolean is
(not After_Last (Next (Tok)) and then
Kind (Next (Tok)) = Res_Begin);
function Next_Is_End (Tok : Tokn_Cursor) return Boolean is
(not After_Last (Next (Tok)) and then
(Kind (Next (Tok)) = Res_End
or else Kind (Next_ss (Tok)) = Res_End));
function Next_Is_End_Record (Tok : Tokn_Cursor) return Boolean is
(not After_Last (Next (Tok)) and then
((Kind (Next (Tok)) = Res_End
and then (not After_Last (Next_ss (Next (Tok)))
and then Kind (Next_ss (Next (Tok))) = Res_Record))
or else
(Kind (Next_ss (Tok)) = Res_End
and then
(not After_Last (Next_ss (Next_ss (Tok)))
and then Kind (Next_ss (Next_ss (Tok))) = Res_Record))));
function Next_Is_End_Case (Tok : Tokn_Cursor) return Boolean is
(not After_Last (Next (Tok)) and then
((Kind (Next (Tok)) = Res_End
and then (not After_Last (Next_ss (Next (Tok)))
and then Kind (Next_ss (Next (Tok))) = Res_Case))
or else
(Kind (Next_ss (Tok)) = Res_End
and then
(not After_Last (Next_ss (Next_ss (Tok)))
and then Kind (Next_ss (Next_ss (Tok))) = Res_Case))));
function Next_Is_Inside_Case (Tok : Tokn_Cursor) return Boolean
is
(not After_Last (Next (Tok)) and then
Kind (Next (Tok)) in Res_Case | Res_When);
function Next_Is_Inside_If (Tok : Tokn_Cursor) return Boolean is
(not After_Last (Next (Tok)) and then
Kind (Next (Tok)) in Res_Else | Res_Elsif);
use Source_Message_Vectors;
Other_Sloc : constant String := Sloc_Image (Sloc (Last_Pp_Off_On));
Message : Source_Message := (Sloc (Src_Tok), others => <>);
-- Start of processing for Insert_Whole_Line_Comment
begin
-- Processing in preparation for Copy_Pp_Off_Regions. That depends
-- on an alternating sequence: OFF, ON, OFF, ON, .... So we check
-- that here, and abort processing if it's not true.
case Whole_Line_Comment'(Kind (Src_Tok)) is
when Pp_Off_Comment =>
if Pp_On then
Pp_On := False;
Last_Pp_Off_On := Src_Tok;
pragma Assert (Last_Pp_Off_On /= First (Src_Tokns'Access));
else
Utils.Char_Vectors.Char_Vectors.Append
(Message.Text,
"pretty printing already disabled at " & Other_Sloc);
Append (Messages, Message);
raise Post_Tree_Phases_Done;
end if;
when Pp_On_Comment =>
if Pp_On then
Utils.Char_Vectors.Char_Vectors.Append
(Message.Text,
"pretty printing already enabled at " & Other_Sloc);
Append (Messages, Message);
raise Post_Tree_Phases_Done;
else
Pp_On := True;
Last_Pp_Off_On := Src_Tok;
pragma Assert (Last_Pp_Off_On /= First (Src_Tokns'Access));
end if;
when Other_Whole_Line_Comment |
Special_Comment | Fillable_Comment => null;
end case;
-- Comments at the beginning are not indented. The "2" is to skip
-- the initial sentinel NL.
if Kind (Prev (Prev (New_Tok))) = Start_Of_Input then
Indentation := Lines_Data.Initial_Indentation;
-- Otherwise, we indent as for the max of the preceding and
-- following line breaks, except when Look_Before is False (as it
-- is for this comment, which is followed by "else").
else
Indentation := After_Indentation;
if Look_Before then
-- If last lines-breaks indentation does not affect comments
-- and if the previous line is a blank line and the following
-- line is a subprogram declaration, the after indentation
-- value is kept.
if not Prev_Indentation_Affect_Comments and then
Next_Is_Action (New_Tok) and then
(Is_Blank_Line (Prev_ss (Src_Tok))
or else
(Kind (Src_Tok) = Other_Whole_Line_Comment and then
Kind (New_Tok) = Enabled_LB_Token and then
Kind (Prev (New_Tok)) = ';'))
then
null;
-- Handling the case where a new comment is added after a
-- sequence of ");" and separated by a blank line from a
-- code line. In this case the alignment will be based on
-- the following line indentation.
elsif Prev_Indentation_Affect_Comments and then
Is_Blank_Line (Prev_ss (Src_Tok)) and then
Kind (New_Tok) = Enabled_LB_Token and then
Kind (Prev (New_Tok)) = ';' and then
Kind (Prev (Prev (New_Tok))) = ')'
then
-- Preserve the maximal indentation level when the
-- current ');' is followed by an IF statement part or a
-- CASE statement part or a BEGIN or END keyword align
-- with the following line of code otherwise (i.e., keep
-- the after indentation level).
if Next_Is_Begin (New_Tok) or else
Next_Is_End (New_Tok) or else
Next_Is_Inside_If (New_Tok) or else
Next_Is_Inside_Case (New_Tok)
then
Indentation :=
Natural'Max (Indentation, Before_Indentation);
end if;
-- Preserve the following type indentation level when
-- the current ';' is followed by a type declaration.
elsif Prev_Indentation_Affect_Comments
and then Is_Blank_Line (Prev_ss (Src_Tok))
and then Kind (New_Tok) = Enabled_LB_Token
and then Kind (Prev (New_Tok)) = ';'
and then Next_Is_Type (Next_ss (New_Tok))
then
null;
-- This is for the situation where no Enabled_LB_Token is
-- present and the indentation information is held by
-- Disabled_LB_Token. In this situation, since if this
-- information affects comments then this information should
-- be used to compute the right indentation value.
elsif Prev_Indentation_Affect_Comments
and then (Kind (Src_Tok) = Other_Whole_Line_Comment
or else Kind (Src_Tok) = Fillable_Comment)
and then (Kind (New_Tok) = Ident
or else Kind (New_Tok) = Res_Others
or else Kind (New_Tok) = Res_When
or else Kind (New_Tok) = Numeric_Literal)
and then Kind (Prev (Prev (New_Tok))) = Disabled_LB_Token
and then Kind (Prev (Prev (Prev (New_Tok)))) in ',' | ';'
then
-- The corrected indentation is based on an already set
-- value on the LB Indentation and it is used to adjust
-- the Cur_Indentation in case of a parathesized context.
declare
P : constant Tokn_Cursor := Prev (Prev (New_Tok));
LB : Line_Break renames
All_LB (Line_Break_Token_Index (P));
begin
if LB.Enabled and then LB.Affects_Comments then
-- Do nothing when ');' is detected before
if not (Kind (Prev (Prev (Prev (New_Tok)))) = ';'
and then
Kind
(Prev (Prev (Prev (Prev (New_Tok))))) =
')')
then
Corrected_Indentation := LB.Indentation;
Indentation := Corrected_Indentation;
end if;
else
Indentation :=
Natural'Max (Indentation, Before_Indentation);
end if;
end;
-- Whole line comment between last aggregate parameter and
-- closing parathesis should be aligned with the others
-- aggregates and closing parenthesis should have the right
-- indentation too.
elsif Prev_Indentation_Affect_Comments
and then (Kind (Src_Tok) = Other_Whole_Line_Comment
or else Kind (Src_Tok) = Fillable_Comment)
and then Kind (Prev (New_Tok)) = Ident
and then Kind (New_Tok) = ')'
and then Kind (Next (New_Tok)) = ';'
and then
Kind (Prev (Prev (Prev (New_Tok)))) = Disabled_LB_Token
then
declare
P : constant Tokn_Cursor :=
Prev (Prev (Prev (New_Tok)));
LB : Line_Break renames
All_LB (Line_Break_Token_Index (P));
begin
if LB.Enabled and then LB.Affects_Comments then
Indentation := LB.Indentation;
Corrected_Indentation := Indentation;
end if;
end;
-- Preserve the following type indentation level when
-- the current ';' is followed by a type declaration,
-- action or identifier.
elsif Prev_Indentation_Affect_Comments
and then Kind (Src_Tok) = Other_Whole_Line_Comment
and then Kind (New_Tok) = Enabled_LB_Token
and then Kind (Prev (New_Tok)) = ';'
and then (Next_Is_Action (New_Tok)
or else Next_Is_Identifier (New_Tok))
then
null;
-- The next case deals with comments between the
-- Param_Spec and the return keyword.
--
-- function Foo
-- (-- Comment about A
-- A : Integer;
-- -- Comment about B
-- B : Float)
-- -- Why put a comment here?
-- return Boolean;
elsif Prev_Indentation_Affect_Comments
and then Kind (Src_Tok) in
Other_Whole_Line_Comment | Fillable_Comment
-- Here look for the sequence:
-- )
-- Line_Break_Token
-- Spaces
-- return
and then (Kind (New_Tok) = Res_Return
and then Kind (Prev (New_Tok)) = Spaces
and then Kind (Prev (Prev (New_Tok))) in
Line_Break_Token
and then Kind (Prev (Prev (Prev (New_Tok)))) =
')')
then
declare
P : constant Tokn_Cursor := Prev (Prev (New_Tok));
LB : Line_Break renames
All_LB (Line_Break_Token_Index (P));
begin
Indentation := LB.Indentation;
Corrected_Indentation := Indentation;
end;
-- The next case deals with a comment right after the with
-- keyword of an aspect clause. This comment must be
-- affected by the with keyword identation.
elsif Kind (Src_Tok) in
Other_Whole_Line_Comment | Fillable_Comment
-- Here look for the sequence:
-- with
-- Line_Break_Token
-- Spaces
and then (Kind (New_Tok) = Enabled_LB_Token
and then Kind (Prev (New_Tok)) = Res_With
and then Kind (Prev (Prev (New_Tok))) in
Spaces)
then
declare
LB : Line_Break renames
All_LB (Line_Break_Token_Index (New_Tok));
begin
Indentation := LB.Indentation;
Corrected_Indentation := Indentation;
end;
elsif Prev_Indentation_Affect_Comments
and then Kind (New_Tok) = Res_Record
and then Kind (Src_Tok) in
Other_Whole_Line_Comment | Fillable_Comment
and then
Kind (Prev (Prev (Prev (Src_Tok)))) = End_Of_Line_Comment
and then
Kind (Prev_ss (Prev (Prev (Prev (Src_Tok))))) = Res_Is
and then Kind (Next (New_Tok)) = Enabled_LB_Token
then
-- This is the case of a type declaration having an EOL
-- comment and a whole line or fillable comment between
-- "is" and "record" keyword.
-- In this case, the line comment should be aligned on
-- the type indentation.
Indentation := Before_Indentation;
elsif Prev_Indentation_Affect_Comments
and then Kind (New_Tok) = Enabled_LB_Token
and then Kind (Src_Tok) in
Other_Whole_Line_Comment | Fillable_Comment
and then Kind (Prev (New_Tok)) = ';'
and then Next_Is_Action (New_Tok)
then
-- The aligment of the comment following a previous
-- line ended by ';' is considered as is condidered as a
-- comment aligned on the indentation level of the next
-- action.
if Indentation /= After_Indentation then
Indentation := After_Indentation;
end if;
elsif Prev_Indentation_Affect_Comments
and then Kind (Src_Tok) in
Other_Whole_Line_Comment | Fillable_Comment
and then Kind (New_Tok) = Enabled_LB_Token
and then Kind (Prev (New_Tok)) = ';'
and then (Next_Is_End (New_Tok)
and not (Next_Is_End_Record (New_Tok)
or Next_Is_End_Case (New_Tok)))
then
if After_Indentation = Indentation then
Indentation := Indentation + PP_Indentation (Cmd);
else
Indentation := Natural'Max (Indentation,
Before_Indentation);
end if;
elsif not Prev_Indentation_Affect_Comments
and then Kind (Src_Tok) in
Other_Whole_Line_Comment | Fillable_Comment
and then Kind (New_Tok) = Enabled_LB_Token
and then Kind (Prev (New_Tok)) = ';'
and then (Next_Is_Type (New_Tok)
or Next_Is_Action (New_Tok))
then
null;
elsif not Prev_Indentation_Affect_Comments
and then Kind (Src_Tok) in
Other_Whole_Line_Comment | Fillable_Comment
and then Kind (New_Tok) = Enabled_LB_Token
and then Kind (Prev (New_Tok)) = ';'
and then Next_Is_Begin (New_Tok)
then
Indentation := Indentation + PP_Indentation (Cmd);
elsif Prev_Indentation_Affect_Comments
and then Kind (Src_Tok) in
Other_Whole_Line_Comment | Fillable_Comment
and then Kind (New_Tok) = Enabled_LB_Token
and then Kind (Prev (New_Tok)) = ';'
and then Kind (Next (New_Tok)) = Ident
and then Kind (Prev (Src_Tok)) = Spaces
and then Kind (Next (Src_Tok)) in True_End_Of_Line
and then Kind (Next (Next (Src_Tok))) in True_End_Of_Line
and then Kind (Next (Next (Next (Src_Tok)))) = Spaces
then
-- This is a situation like below
-- type Natural is new Integer with
-- Predicate => Natural >= 0;
--
-- -- A_Case_Expression
--
-- N : Integer := 123;
--
-- In such cases the comment should be aligned with the
-- following declaration
null;
elsif Prev_Indentation_Affect_Comments
and then Kind (Src_Tok) = Fillable_Comment
and then Kind (New_Tok) in Res_Function | Res_Procedure
and then Kind (Prev (New_Tok)) = Enabled_LB_Token
and then Kind (Next (New_Tok)) = Spaces
and then Kind (Prev_ss (Src_Tok)) in True_End_Of_Line
and then Kind (Next_ss (Src_Tok)) in True_End_Of_Line
and then Kind
(Next_ss (Next_ss (Src_Tok))) = Other_Whole_Line_Comment
then
Indentation := Before_Indentation;
else
Indentation :=
Natural'Max (Indentation, Before_Indentation);
end if;
end if;
end if;
-- If we're inside something parenthesized, add an extra level
-- (Note : this is a particular alignment case handled to avoid
-- regressions in internal-testsuite tests MB20-050 and R504-012)
if Kind (New_Tok) = ')' and then
(Kind (Next (Next (New_Tok))) = Res_Is
or else (Kind (Next (New_Tok)) = Disabled_LB_Token and then
Kind (Next (Next (New_Tok))) = Spaces and then
Kind (Next (Next (Next (New_Tok)))) = Res_Return))
then
Indentation := Indentation + PP_Indentation (Cmd);
end if;
-- V111-001:
-- This is needed to take into account the paranthesis level and
-- add 1 to be inside of the paranthesis for the next line
-- indentation (see above for Corrected_Indentation value)
if Corrected_Indentation /= 0
and then Corrected_Indentation /= Indentation
then
Indentation := Corrected_Indentation;
end if;
Set_Cur_Indentation;
if Is_Blank_Line (Prev_ss (Src_Tok))
or else Kind (Last (New_Tokns'Access)) /= Enabled_LB_Token
then
if Arg (Cmd, Source_Line_Breaks) then
declare
P : Tokn_Cursor := Last (New_Tokns'Access);
begin
while Kind (P) in
Line_Break_Token | End_Of_Line_Comment | Spaces
loop
Prev (P);
end loop;
if Kind (P) not in Whole_Line_Comment | ',' then
Append_Temp_Line_Break
(Lines_Data_P,
Org => "Append_Temp_ in Insert_Whole_Line_Comment");
end if;
end;
else
Append_Temp_Line_Break
(Lines_Data_P,
Org => "Append_Temp_ in Insert_Whole_Line_Comment");
end if;
end if;
loop
-- ???Handle blank lines here, too?
Insert_Comment_Text (Lines_Data_P, Cmd, Src_Tok);
Next_ss (Src_Tok);
pragma Assert (Kind (Src_Tok) in EOL_Token);
Next_ss (Src_Tok);
exit when Kind (Src_Tok) not in
Special_Comment | Fillable_Comment | Other_Whole_Line_Comment;
Set_Cur_Indentation;
Append_Temp_Line_Break
(Lines_Data_P,
Org => "Append_Temp_ in Insert_Whole_Line_Comment 2");
end loop;
-- A line break is needed after the comment. If one is not already
-- there, add one.
if Kind (New_Tok) = Enabled_LB_Token then
while All_LB (Enabled_LBI (Enabled_Cur_Line)).Tok /= New_Tok loop
Enabled_Cur_Line := Enabled_Cur_Line + 1;
end loop;
end if;
declare
LB : Line_Break renames All_LB (Enabled_LBI (Enabled_Cur_Line));
pragma Assert (if Kind (New_Tok) = Enabled_LB_Token then
LB.Tok = New_Tok);
pragma Assert
(if LB_Tok (LB) = New_Tok then
Kind (New_Tok) = Enabled_LB_Token);
pragma Assert
(if not Partial_GNATPP then
(if LB_Tok (LB) = Prev (New_Tok) then
(if not Arg (Cmd, Source_Line_Breaks) then
Kind (Prev (New_Tok)) = Disabled_LB_Token)));
begin
if LB.Tok = New_Tok then
-- The inserted LB.Indentation is set to 0 when the LB is
-- added in case of --insert-blank-lines switch usage
-- Take the Cur_Indentation value as reference in that case
-- for the current line break indentation.
if Insert_Blank_Lines (Cmd) and then
LB.Indentation = 0
then
if LB.Indentation < Cur_Indentation then
LB.Indentation := Cur_Indentation;
elsif Cur_Indentation = 0 and then
LB.Indentation < Indentation
then
-- Update the indentation level for current line break
-- to the expected level after this comment.
LB.Indentation := Indentation;
end if;
end if;
Append_Tokn
(New_Tokns, False_End_Of_Line, "whole line extra");
-- This is needed because every comment in New_Tokns must
-- be followed by EOL_Token.
elsif (Kind (New_Tok) = Ident
or else Kind (New_Tok) = Res_Others
or else Kind (New_Tok) = Numeric_Literal)
and then Kind (New_Tok) = Kind (Src_Tok)
and then Kind (Prev (Prev (Src_Tok))) in True_End_Of_Line
and then (Kind
(Prev (Prev (Prev (Src_Tok)))) =
Other_Whole_Line_Comment
or else Kind (Prev (Prev (Prev (Src_Tok)))) =
Fillable_Comment)
and then Kind (Prev (Prev (Prev (New_Tok)))) in ',' | ';'
and then Kind (Prev (Prev (New_Tok))) in Disabled_LB_Token
then
-- V111-001
-- Avoid adding an empty line after a whole line comment
-- between two parameters
-- A (X => 1,
-- -- whole line comment
-- False);
-- In case of paranthesized expressions (like paramaters of
-- and action call) the indentation must be corrected if this
-- was not already taken as set in the Disabled_LB_Token
-- Indentation field.
null;
elsif Kind (Prev (New_Tok)) in Spaces
and then Kind (Prev (Prev (New_Tok))) in Disabled_LB_Token
and then Kind (Prev (Prev (Prev (New_Tok)))) in ','
and then Kind (Next_ss (New_Tok)) in Tab_Token
and then Kind (Next (Next_ss (New_Tok))) in Arrow
and then not (Kind (Src_Tok) in True_End_Of_Line
and then Kind (Prev (Src_Tok)) in
True_End_Of_Line)
then
-- U329-016
-- Avoid adding an empty line after a whole line comment
-- betweeen two value assignments of enumerations, unless
-- the whole line comment is itselft surrounded by empty
-- lines.
--
-- ...
-- literal_foo => literal_foo_value,
-- -- Some comment (does not add a LB here)
-- literal_bar => literal_bar_value,
-- ...
--
-- ...
-- literal_foo => literal_foo_value,
--
-- -- Some comment (but adds a LB here)
--
-- literal_bar => literal_bar_value,
-- ...
null;
elsif Arg (Cmd, Source_Line_Breaks)
and then not Partial_GNATPP
and then
((Kind (Src_Tok) in True_End_Of_Line
and then Kind (Prev (Src_Tok)) in True_End_Of_Line
and then Kind (Prev (Prev (Src_Tok))) in
Other_Whole_Line_Comment | Fillable_Comment
and then Kind (Next_ss (Src_Tok)) = Kind (New_Tok)
and then Kind (Prev (Prev (New_Tok))) = Disabled_LB_Token
and then Kind (Prev (Prev (Prev (New_Tok)))) in ',')
or else
(Kind (Src_Tok) = Kind (New_Tok)
and then
((Kind (Prev (Prev (Src_Tok))) =
Other_Whole_Line_Comment
and then Kind (Prev (Prev (Prev (Src_Tok)))) in
True_End_Of_Line)
or else
(Kind (Prev (Prev (Src_Tok))) in True_End_Of_Line
and then Kind (Prev (Prev (Prev (Src_Tok)))) =
Fillable_Comment))
and then Kind (Next_ss (Src_Tok)) in Ident | ',' | ')'
and then Kind (Prev (Prev (New_Tok))) = Disabled_LB_Token
and then Kind (Prev (Prev (Prev (New_Tok)))) in
Res_Is | ',')
or else
(Kind (Src_Tok) in True_End_Of_Line
and then Kind (Prev (Prev (Src_Tok))) in
Other_Whole_Line_Comment | Fillable_Comment
and then Kind (Prev (Prev (Prev (Src_Tok)))) in
True_End_Of_Line | Spaces
and then Kind (New_Tok) = '('
and then Kind (New_Tok) = Kind (Next_ss (Src_Tok))
and then Kind (Prev (Prev (New_Tok))) = Disabled_LB_Token
and then Kind (Prev (Prev (Prev (New_Tok)))) in
Res_Is | ',')
or else
(Kind (Src_Tok) in True_End_Of_Line
and then Kind (Prev (Prev (Src_Tok))) =
Fillable_Comment
and then Kind (Prev (Prev (Prev (Src_Tok)))) = Spaces
and then Kind (New_Tok) = '('
and then Kind (New_Tok) = Kind (Next_ss (Src_Tok))
and then Kind (Prev (Prev (New_Tok))) = Spaces
and then Kind (Prev (Prev (Prev (New_Tok)))) =
Disabled_LB_Token)
or else
(Kind (Src_Tok) in True_End_Of_Line
and then Kind (Prev (Prev (Src_Tok))) =
Other_Whole_Line_Comment
and then Kind (Prev (Prev (Prev (Src_Tok)))) in
True_End_Of_Line
and then Kind (New_Tok) = Res_Then
and then Kind (New_Tok) = Kind (Next_ss (Src_Tok))
and then Kind (Prev (Prev (New_Tok))) = Disabled_LB_Token
and then Kind (Prev (Prev (Prev (New_Tok)))) =
Character_Literal))
then
-- The Disabled_LB_Token was enabled and will match the
-- True_End_Of_Line between the source token and a blank line
null;
elsif Kind (LB.Tok) = Disabled_LB_Token
and then Kind (Src_Tok) = Res_Record
and then Kind (Src_Tok) = Kind (New_Tok)
and then Kind (Prev (Prev_ss (Src_Tok))) = Fillable_Comment
and then
Kind (Prev (Prev_ss (Prev (Prev (Prev_ss (Src_Tok)))))) =
End_Of_Line_Comment
and then
Kind (Prev_ss (Prev
(Prev_ss (Prev (Prev (Prev_ss (Src_Tok))))))) = Res_Is
then
null;
else
Cur_Indentation := Indentation;
if Partial_GNATPP
and then Kind (New_Tok) = End_Of_Input
and then Kind (Src_Tok) = End_Of_Input
then
-- For partial formatting no need to add an additional
-- line break after comment.
null;
else
Append_Temp_Line_Break
(Lines_Data_P,
Org => "Append_Temp_ in Insert_Whole_Line_Comment 3");
end if;
end if;
end;
Reset_Indentation;
end Insert_Whole_Line_Comment;
procedure Insert_Preprocessor_Directive is
begin
-- The libadalang parser simply ignores preprocessor directives,
-- so it will produce a more-or-less reasonable tree if the input
-- text is syntactically legal after deleting the directives. The
-- Convert_Tree_To_Ada phase will format based on that tree, so
-- something like:
--
-- package P is
-- #IF SOMETHING
-- X : constant Integer := 123;
-- #ELSE
-- X : constant Integer := 456;
-- #END IF;
-- end P;
--
-- will be formatted as if it were:
--
-- package P is
-- X : constant Integer := 123;
-- X : constant Integer := 456;
-- end P;
--
-- Then this procedure reinserts the directives.
--
-- So there is a limitation: if deleting the directives does not
-- produce text that libadalang can parse, then pretty printing
-- will fail.
Cur_Indentation := Sloc (Src_Tok).Col - 1; -- Keep as in input
Append_Temp_Line_Break
(Lines_Data_P,
Org => "Append_Temp_ Preprocessor_Directive");
Append_Tokn (New_Tokns, Src_Tok);
Next (Src_Tok);
Reset_Indentation;
end Insert_Preprocessor_Directive;
procedure Insert_Private is
begin
-- The previous line break is just before "end";
-- that's the indentation we want for "private".
Cur_Indentation :=
All_LB (Syntax_LBI (Syntax_Cur_Line - 1)).Indentation;
if not Arg (Cmd, Source_Line_Breaks) then
Append_Temp_Line_Break
(Lines_Data_P, Org => "Append_Temp_ private 1");
end if;
Append_Tokn (New_Tokns, Res_Private);
-- If Source_Line_Breaks, then avoid running "private end"
-- together into "privateend".
if Arg (Cmd, Source_Line_Breaks) then
Append_Spaces (New_Tokns, Count => 1);
else
Append_Temp_Line_Break
(Lines_Data_P, Org => "Append_Temp_ private 2");
end if;
Reset_Indentation;
Next_ss (Src_Tok);
end Insert_Private;
Qual_Nesting : Natural := 0;
-- Count the nesting level of qualified expressions containing aggregates
-- with extra parentheses.
-- Start of processing for Insert_Comments_And_Blank_Lines
begin
pragma Debug
(Format_Debug_Output
(Lines_Data, "before Insert_Comments_And_Blank_Lines"));
-- ???At this point, we might need another pass to insert hard line
-- breaks after end-of-line comments, so they will be indented properly.
-- Or better yet, insert the EOL comments, with tabs and soft line break
-- before, hard line break after.
Collect_Line_Breaks
(Lines_Data_P, Saved_New_Tokns,
Do_All => True, Do_Enabled => True, Do_Syntax => True,
First_Time => False);
Append_Tokn (Pending_Tokns, Start_Of_Input);
pragma Assert (Is_Empty (New_Tokns));
Scanner.Clear (New_Tokns);
Append_Tokn (New_Tokns, Start_Of_Input);
-- Skip initial EOL_Token token
pragma Assert (Kind (New_Tok) = Enabled_LB_Token);
if Arg (Cmd, Source_Line_Breaks) then
All_LB (Line_Break_Token_Index (New_Tok))
.Source_Line_Breaks_Enabled := True;
end if;
New_To_Newer;
New_Line_Start_Out := New_Tok;
pragma Assert (Is_Empty (Temp_LBI));
-- The two sequences Src_Tokns and Out_Tokns should be identical,
-- with some exceptions where mismatches are possible. The code below
-- to insert comments depends on this fact. We step through the two
-- sequences, copying text into Buffer, and detect any token mismatch.
-- The allowed mismatches are:
--
-- The Out sequence has no comments, so when we detect a mismatch and
-- the source one is a comment, that's where we insert the comment.
--
-- The sequences may have blank lines in different places.
--
-- We normalize "end;" to "end Some_Name;"
--
-- We normalize by removing "private" from a package (etc) when there
-- is nothing in the private part. We put the "private" back in here.
--
-- We normalize a qualified expression with unnecessary parentheses
-- containing an aggregate. That is "T'((X, Y, Z))" is normalized to
-- "T'(X, Y, Z)", where "(X, Y, Z)" is an aggregate. We pretty-much
-- have to do that, because ASIS provides no way to distinguish these
-- two forms.
--
-- There is a mode in which we insert underscores in numeric
-- literals, as in 12_345_678.
--
-- Allowed Replacements of Characters (see RM-J.2). We normalize "!"
-- to "|" when used as a delimiter. The other allowed replacements
-- (: for # and % for ") are not normalized.
--
-- Any other mismatch is considered to be a bug.
loop
pragma Assert (Kind (New_Tok) not in Comment_Kind);
Manage_Paren_Stack;
-- The order of the if/elsif's below is important in some
-- cases. Blank lines must be handled late, even if they match.
-- End_Of_Line_Comments must be handled before blank lines,
-- because they need to appear at the end of the preceding line.
-- Whole_Line_Comments must be handled after blank lines, because
-- the blank line should precede the comment.
if Kind (Src_Tok) not in EOL_Token
and then
(Match (Src_Tok, New_Tok)
or else (Kind (Src_Tok) = '!' and then Kind (New_Tok) = '|'))
then
exit when Kind (Src_Tok) = End_Of_Input;
-- i.e. exit when both Src and Out are at end of input
pragma Assert (Kind (New_Tok) /= Enabled_LB_Token);
-- No need to set New_Line_Start_Out
Next_ss (Src_Tok);
New_To_Newer;
else
-- Check for "end;" --> "end Some_Name;" case
if Kind (Src_Tok) = ';'
and then
Kind (Prev_Lexeme (Src_Tok)) = Res_End
and then Sname_83 (New_Tok)
then
loop -- could be "end A.B.C;"
New_To_Newer;
exit when Kind (New_Tok) /= '.';
New_To_Newer ('.');
pragma Assert (Sname_83 (New_Tok));
end loop;
pragma Assert
(Disable_Final_Check or else
Kind (Src_Tok) in ';' | EOL_Token | Comment_Kind);
-- Check for "end Some_Name;" --> "end;" case. This only happens
-- when the --no-end-id switch was given. Here, the name was
-- present in the source, so we insert it.
elsif not Arg (Cmd, End_Id)
and then Kind (New_Tok) = ';'
and then
Kind (Prev_Lexeme (New_Tok)) = Res_End
and then Kind (Src_Tok) in Ident | String_Lit
then
Append_Tokn (New_Tokns, Spaces, Name_Space);
loop -- could be "end A.B.C;"
Append_Tokn (New_Tokns, Src_Tok);
Next_ss (Src_Tok);
exit when Kind (Src_Tok) /= '.';
Append_Tokn (New_Tokns, Src_Tok);
Next_ss (Src_Tok);
pragma Assert
(Kind (Src_Tok) in Ident | String_Lit);
end loop;
pragma Assert
(Disable_Final_Check or else Kind (Src_Tok) = ';');
-- Check for "private end" --> "end" case, with a possible
-- comment between "private" and "end".
elsif Kind (Src_Tok) = Res_Private
and then Kind (New_Tok) = Res_End
then
pragma Assert
(Disable_Final_Check
or else Kind (Next_Lexeme (Src_Tok)) = Res_End);
Insert_Private;
-- Check for "T'((X, Y, Z))" --> "T'(X, Y, Z)" case
elsif Kind (Src_Tok) = '('
and then Kind (Prev_Lexeme (Src_Tok)) = '('
--???Also check that the one before that is a tick!
then
Qual_Nesting := Qual_Nesting + 1;
Append_Tokn (New_Tokns, Src_Tok);
Next_ss (Src_Tok);
elsif Qual_Nesting > 0
and then Kind (Src_Tok) = ')'
and then Kind (Prev_Lexeme (Src_Tok)) = ')'
then
Qual_Nesting := Qual_Nesting - 1;
Append_Tokn (New_Tokns, Src_Tok);
Next_ss (Src_Tok);
elsif Kind (Src_Tok) = End_Of_Line_Comment then
Insert_End_Of_Line_Comment;
-- If the source has a blank line at this point, send it to the
-- output (unless Insert_Blank_Lines is True, in which case we
-- want to ignore blank lines in the input, since a previous
-- phase inserted them in the "right" place). But avoid
-- multiple blank lines (unless either Preserve_Line_Breaks or
-- Preserve_Blank_Lines is True) and blank lines just before
-- End_Of_Input.
elsif Is_Blank_Line (Src_Tok)
and then not Arg (Cmd, Source_Line_Breaks)
then
-- Src_Tok is the second in a series of two or more
-- EOL_Tokens.
declare
pragma Assert (Kind (Prev_ss (Src_Tok)) in EOL_Token);
Prev_Prev_Tok_Kind : constant Token_Kind :=
Kind (Prev_ss (Prev_ss (Src_Tok)));
begin
loop
Next_ss (Src_Tok);
exit when Kind (Src_Tok) not in EOL_Token
or else Preserve_Blank_Lines (Cmd);
end loop;
declare
Next_Tok_Kind : constant Opt_Token_Kind :=
(if At_Last (Src_Tok)
then Nil
else Kind (Next_ss (Src_Tok)));
begin
if Preserve_Blank_Lines (Cmd)
or else (not Insert_Blank_Lines (Cmd)
and then Kind (Src_Tok) /= End_Of_Input)
or else Prev_Prev_Tok_Kind in Comment_Kind
or else Next_Tok_Kind in Comment_Kind
then
Append_Temp_Line_Break
(Lines_Data_P, Org => "Append_Temp_ blank line");
end if;
end;
end;
-- Normally, we simply ignore EOL_Token in the input. But for
-- --source-line-breaks mode, if we see a line break in the
-- input that is not yet in the output, we copy it over.
-- We set the indentation to take into account
-- surrounding indentation, plus line continuation if
-- appropriate, plus "("-related indentation. If the next
-- character in the output is already ' ', we subtract one from
-- the indentation to make up for that. (There can never be two
-- in a row.)
elsif Kind (Src_Tok) in EOL_Token then
pragma Assert
(not Is_Blank_Line (Src_Tok)
or else Arg (Cmd, Source_Line_Breaks));
Next_ss (Src_Tok);
if Arg (Cmd, Source_Line_Breaks) then
if Kind (New_Tok) in Line_Break_Token then
declare
LB : Line_Break renames
All_LB (Line_Break_Token_Index (New_Tok));
begin
-- If we have a line break with
-- Source_Line_Breaks_Enabled already True, it means
-- we already did New_To_Newer in the 'else' below
-- for a previous EOL_Token, so create a new one
-- with the same indentation.
if LB.Source_Line_Breaks_Enabled then
Cur_Indentation := LB.Indentation;
Append_Temp_Line_Break
(Lines_Data_P,
Org => "Append_Temp_ Source_Line_Breaks 1");
Reset_Indentation;
New_Line_Start_Out := New_Tok;
-- Source_Line_Breaks_Enabled is False, so tell
-- New_To_Newer to use this line break.
else
LB.Enabled := True;
LB.Source_Line_Breaks_Enabled := True;
if Kind (Src_Tok) in Whole_Line_Comment then
New_To_Newer;
New_Line_Start_Out := New_Tok;
end if;
end if;
end;
-- There is no line break in New_Tokns corresponding to
-- the EOL_Token in the source, so create a new one using
-- Append_Temp_Line_Break.
else
declare
Indentation : Natural := 0;
P : Tokn_Cursor := New_Tok;
begin
case Kind (New_Tok) is
when Res_Is | Comment_Kind =>
Indentation := Before_Indentation;
when others =>
while Kind (P) not in Line_Break_Token loop
P := Prev (P);
end loop;
declare
LB : Line_Break renames
All_LB (Line_Break_Token_Index (P));
begin
if Kind (P) = Disabled_LB_Token
and then LB_Needs_To_Be_Enabled (Src_Tok)
then
LB.Enabled := True;
LB.Affects_Comments := True;
end if;
if not Is_Empty (Paren_Stack)
and then Kind (New_Tok) = Ident
and then Kind (P) = Disabled_LB_Token
and then Kind (Prev (P)) = ';'
and then Kind (Prev_ss (Prev (P))) in
Ident | Res_Null | ')'
then
LB.Indentation :=
L_Paren_Indent_For_Preserve
+ Before_Indentation - 1;
elsif not Is_Empty (Paren_Stack)
and then Kind (New_Tok) in
Ident | String_Lit | Character_Literal
and then Kind (P) = Disabled_LB_Token
and then Kind (Prev (P)) = ','
and then Kind (Prev_ss (Prev (P))) in
Ident | String_Lit |
Character_Literal | Numeric_Literal |
Res_All | Res_Null | Box | ')'
then
if
(Kind (Prev_ss (Prev (P))) = ')'
and then
Kind (Prev_ss
(Prev_ss (Prev (P)))) = ')')
or else
(Kind (New_Tok) in Ident | String_Lit
and then
Kind
(Prev_ss (Prev (P))) = String_Lit)
then
-- already up to date indentation
null;
elsif LB.Indentation /=
L_Paren_Indent_For_Preserve
+ Before_Indentation + 1
then
LB.Indentation :=
L_Paren_Indent_For_Preserve
+ Before_Indentation - 1;
end if;
else
if not Is_Empty (Paren_Stack) then
if Kind (New_Tok) = Ident
and then
Kind (P) = Disabled_LB_Token
and then
Kind (Prev (P)) in
Colon_Equal | Arrow
and then
Kind (Prev_ss (Prev (P))) =
Tab_Token
then
null;
elsif Kind (New_Tok) = Ident
and then
Kind (P) = Disabled_LB_Token
and then
Kind
(Prev_ss (Prev (P))) = Res_With
then
Update_L_Paren_Indent_For_Preserve
(LB.Indentation
- Before_Indentation);
elsif Kind (New_Tok) = Ident and then
Kind (P) = Disabled_LB_Token
and then Kind (Prev (P)) = Res_If
and then
Kind (Prev_ss (Prev (P))) = '('
then
-- IF expression starts here
Update_L_Paren_Indent_For_Preserve
(LB.Indentation);
elsif Kind (New_Tok) in
Res_Then | Res_Else
and then
Kind (P) = Disabled_LB_Token
then
Update_L_Paren_Indent_For_Preserve
(LB.Indentation);
else
Update_L_Paren_Indent_For_Preserve
(LB.Indentation
- Before_Indentation + 1);
end if;
end if;
end if;
Indentation := LB.Indentation;
end;
end case;
Cur_Indentation := Indentation;
Append_Temp_Line_Break
(Lines_Data_P,
Org => "Append_Temp_ Source_Line_Breaks 2");
Reset_Indentation;
New_Line_Start_Out := New_Tok;
end;
end if;
end if;
elsif Kind (Src_Tok) in Whole_Line_Comment then
-- In the context of call parameters or aggregate association
-- having a whole line comment inserted in between the
-- elements the present Disabled_LB_Token should be enabled
-- and the indentation needs to be updated in the current
-- token context
-- In a paranthesized context, the indentation level should
-- be increased by 1 related to the last left paranthesis
-- position
if (Kind (Src_Tok) = Other_Whole_Line_Comment
or else Kind (Src_Tok) = Fillable_Comment)
and then (Kind (New_Tok) = Ident
or else Kind (New_Tok) = Res_Others
or else Kind (New_Tok) = Res_When
or else Kind (New_Tok) = Numeric_Literal
or else Kind (New_Tok) = ')')
and then Kind (Prev (Prev (New_Tok))) = Disabled_LB_Token
and then (Kind (Prev (Prev (Prev (New_Tok)))) = ','
or else Kind (Prev (Prev (Prev (New_Tok)))) = ';')
and then not
(Kind (Prev_ss (Src_Tok)) in True_End_Of_Line
and then
(Kind (Prev (Prev_ss (Src_Tok))) = End_Of_Line_Comment
or (Kind (Prev (Prev_ss (Src_Tok))) in
True_End_Of_Line
and
(not After_Last (Prev (Prev_ss (Src_Tok)))
and then
Kind (Prev (Prev (Prev_ss (Src_Tok)))) =
End_Of_Line_Comment))))
then
declare
P : constant Tokn_Cursor := Prev (Prev (New_Tok));
LB : Line_Break renames
All_LB (Line_Break_Token_Index (P));
begin
LB.Enabled := True;
LB.Affects_Comments := True;
if not Is_Empty (Paren_Stack) then
-- Nothing to do here since these situations
-- are handled by other means
if Arg (Cmd, Comments_Unchanged)
or else
Kind
(Prev (Prev (Prev (Prev (New_Tok))))) = ')'
or else Kind (Src_Tok) = Fillable_Comment
then
null;
elsif Arg (Cmd, Source_Line_Breaks) then
if Kind (New_Tok) = Res_When then
Cur_Indentation := LB.Indentation;
elsif Kind (New_Tok) = Ident then
Cur_Indentation :=
L_Paren_Indent_For_Preserve;
end if;
else
LB.Indentation :=
L_Paren_Indent_For_Preserve + 1;
Cur_Indentation := LB.Indentation;
end if;
end if;
end;
end if;
Insert_Whole_Line_Comment;
elsif Kind (Src_Tok) = Preprocessor_Directive then
Insert_Preprocessor_Directive;
elsif Kind (New_Tok) = Enabled_LB_Token then
New_To_Newer;
New_Line_Start_Out := New_Tok;
-- Else print out debugging information and crash. This
-- avoids damaging the source code in case of bugs. However,
-- if the Disable_Final_Check debug flag is set, try to
-- continue by skipping one source token, or one output
-- token.
elsif Disable_Final_Check then
Next_ss (Src_Tok);
if At_Last (Src_Tok) then
goto Done;
end if;
else
-- Handle specific cases in partial formatting where no
-- token mismatch raise is needed
if Partial_GNATPP then
if Kind (Src_Tok) = ';'
and then Kind (Prev (Src_Tok)) in
Res_End | Res_Record | Res_Loop | Ident
| Res_Tagged | Res_Abstract | Res_Null
| Numeric_Literal | String_Lit | ')'
and then Kind (New_Tok) = End_Of_Input
then
Next_ss (Src_Tok);
else
-- When enter here mostly an infinite loop situation
-- is detected in partial mode
raise Partial_GNATPP_Error;
end if;
else
Raise_Token_Mismatch
("Inserting", Lines_Data, Src_Buf, Src_Tok, New_Tok);
end if;
end if;
end if;
if Kind (Src_Tok) not in Comment_Kind
and then Sloc (Src_Tok).Line /= Sloc (Start_Line_Src_Tok).Line
then
Start_Line_Src_Tok := Src_Tok;
end if;
end loop;
if Last_Pp_Off_On /= First (Src_Tokns'Access) then
Pp_Off_Present := True;
end if;
pragma Assert (Is_Empty (Paren_Stack));
pragma Assert (At_Last (Src_Tok));
Append_Tokn (New_Tokns, End_Of_Input);
Erase_LB_Toks (All_LB);
Clear (Saved_New_Tokns);
pragma Assert (Syntax_Cur_Line = Last_Index (Syntax_LBI) + 1);
if not Partial_GNATPP then
pragma Assert (Enabled_Cur_Line = Last_Index (Enabled_LBI));
end if;
<> null;
Clear (Temp_LBI);
pragma Assert (Disable_Final_Check or else Qual_Nesting = 0);
pragma Assert (At_Beginning (Src_Buf));
Clear (Lines_Data.All_LBI);
Clear (Enabled_LBI);
Clear (Syntax_LBI);
end Insert_Comments_And_Blank_Lines;
procedure Insert_Indentation (Lines_Data_P : Lines_Data_Ptr)
is
function Is_Action_Call_Parameter (Tok : Tokn_Cursor) return Boolean;
-- Returns true if the line break token is part of an action call
-- parameter..
function Called_As_Parameter_Of_An_Action_Call (Tok : Tokn_Cursor)
return Boolean;
-- Returns true if the line break token is part of an action call
-- parameter and this call is a parameter of an other action call.
function Enclosing_Open_Paren (Tok : Tokn_Cursor;
OP_Count : Natural) return Tokn_Cursor;
-- Returns the enclosing parenthesis corresponding token.
function Prev_LB_Indentation (Paren : Tokn_Cursor) return Positive;
-- Returns the previous indentation of the 1st found line break before
-- the given '(' token cursor parameter.
procedure Adjust_Indentation_After_Comma (Tok : Tokn_Cursor);
-- This function adjust the indentation level based on the count of
-- the opened parenthesis between two enabled line breaks.
-- This is used in order to adjust line breaks indentation in case
-- of a call parameter.
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
All_LB : Line_Break_Vector renames Lines_Data.All_LB;
function Enclosing_Open_Paren (Tok : Tokn_Cursor;
OP_Count : Natural) return Tokn_Cursor
is
Index : constant Line_Break_Index := Line_Break_Token_Index (Tok);
LB : Line_Break renames All_LB (Index);
Crt_Tok : Tokn_Cursor := Prev (Tok);
Crt_OP_Count : Natural := 0;
Crt_CP_Count : Natural := 0;
begin
pragma Assert (Kind (Tok) in Line_Break_Token
and then LB.Enabled
and then not Is_Nil (Crt_Tok));
while not Is_Nil (Crt_Tok) loop
if Kind (Crt_Tok) = ')' then
Crt_CP_Count := Crt_CP_Count + 1;
elsif Kind (Crt_Tok) = '(' then
Crt_OP_Count := Crt_OP_Count + 1;
end if;
if Crt_OP_Count = OP_Count + 1 then
return Crt_Tok;
end if;
exit when Is_Nil (Crt_Tok)
or else
Kind (Crt_Tok)
in Res_For | Res_When | Res_Begin | Res_Is | Colon_Equal;
Crt_Tok := Prev (Crt_Tok);
end loop;
return Nil_Tokn_Cursor;
end Enclosing_Open_Paren;
function Is_Action_Call_Parameter (Tok : Tokn_Cursor) return Boolean
is
Index : constant Line_Break_Index := Line_Break_Token_Index (Tok);
LB : Line_Break renames All_LB (Index);
Crt_Tok : Tokn_Cursor := Prev (Tok);
function Pattern_Found (Tok : Tokn_Cursor) return Boolean is
((Kind (Prev (Tok)) = Spaces
and then Kind (Prev (Prev (Tok))) = Ident)
or else
(Kind (Prev (Tok)) in Line_Break_Token
and then Kind (Prev (Prev (Tok))) = Ident));
-- Returns True if the pattern "Ident/Spaces/'('" is found
begin
pragma Assert (Kind (Tok) in Line_Break_Token
and then LB.Enabled
and then not Is_Nil (Crt_Tok)
and then Kind (Crt_Tok) in Arrow | ',');
while not Is_Nil (Crt_Tok) loop
if Kind (Crt_Tok) = '(' then
if Pattern_Found (Crt_Tok) then
return True;
end if;
elsif Kind (Crt_Tok) = ')' then
if Kind (Prev (Tok)) = ',' then
return False;
end if;
end if;
exit when Is_Nil (Crt_Tok)
or else
Kind (Crt_Tok)
in Res_For | Res_When | Res_Begin | Res_Is | Colon_Equal |
Res_Package | Res_With | Start_Of_Input;
Crt_Tok := Prev (Crt_Tok);
end loop;
return False;
end Is_Action_Call_Parameter;
function Called_As_Parameter_Of_An_Action_Call
(Tok : Tokn_Cursor) return Boolean
is
Index : constant Line_Break_Index := Line_Break_Token_Index (Tok);
LB : Line_Break renames All_LB (Index);
Crt_Tok : Tokn_Cursor := Prev (Tok);
function Call_Pattern_Found (Tok : Tokn_Cursor) return Boolean is
(not Is_Nil (Prev (Tok)) and then not Is_Nil (Prev (Prev (Tok)))
and then ((Kind (Prev (Tok)) = Spaces
and then Kind (Prev (Prev (Tok))) = Ident)
or else
(Kind (Prev (Tok)) in Line_Break_Token
and then Kind (Prev (Prev (Tok))) = Ident)));
Pattern_Found : Boolean := False;
Call_Ident_Tok : Tokn_Cursor := Nil_Tokn_Cursor;
Count : Natural := 0;
begin
pragma Assert (Kind (Tok) in Line_Break_Token
and then LB.Enabled
and then not Is_Nil (Crt_Tok)
and then Kind (Crt_Tok) in Arrow | ',');
if not Is_Action_Call_Parameter (Tok) then
return False;
end if;
while not Is_Nil (Crt_Tok) loop
if Kind (Crt_Tok) = '(' then
if Call_Pattern_Found (Crt_Tok) then
Pattern_Found := True;
Call_Ident_Tok :=
(if not Is_Nil (Prev (Crt_Tok))
and then not Is_Nil (Prev (Prev (Crt_Tok)))
and then not Is_Nil (Prev (Prev (Prev (Crt_Tok))))
then Prev (Prev (Prev (Crt_Tok)))
else Nil_Tokn_Cursor);
exit;
end if;
end if;
exit when Is_Nil (Crt_Tok)
or else
Kind (Crt_Tok)
in Res_For | Res_When | Res_Begin | Res_Is | Colon_Equal
| Start_Of_Input;
Crt_Tok := Prev (Crt_Tok);
end loop;
-- Look backward starting from the call to identify if it is a
-- a parameter of an other action call
if not Pattern_Found then
return False;
end if;
Crt_Tok := Call_Ident_Tok;
while not Is_Nil (Crt_Tok) loop
case Kind (Crt_Tok) is
when ',' | Arrow =>
return True;
when ')' =>
Count := Count + 1;
when '(' =>
if Count = 0 then
if Call_Pattern_Found (Crt_Tok) then
return True;
end if;
else
Count := Count - 1;
end if;
when others => null;
end case;
exit when Is_Nil (Crt_Tok)
or else
Kind (Crt_Tok)
in Res_For | Res_When | Res_Begin | Res_Is | Colon_Equal
| Start_Of_Input;
Crt_Tok := Prev (Crt_Tok);
end loop;
return False;
end Called_As_Parameter_Of_An_Action_Call;
function Is_Expected_Token (Tok : Tokn_Cursor) return Boolean
is (Kind (Prev (Tok)) in ',' | '&' | ';' | ''' | Arrow
or else (Kind (Prev (Tok)) = Ident and Kind (Next (Tok)) = '('));
function Prev_LB_Indentation (Paren : Tokn_Cursor) return Positive
is
Crt_Tok : Tokn_Cursor := Paren;
begin
while not Is_Nil (Crt_Tok) loop
if Kind (Crt_Tok) = Enabled_LB_Token then
declare
Index : constant Line_Break_Index :=
Line_Break_Token_Index (Crt_Tok);
LB : Line_Break renames All_LB (Index);
begin
return LB.Indentation;
end;
end if;
exit when Is_Nil (Crt_Tok)
or else
Kind (Crt_Tok)
in Res_For | Res_When | Res_Begin | Res_Is | Colon_Equal
| Start_Of_Input;
Prev (Crt_Tok);
end loop;
return 1;
end Prev_LB_Indentation;
procedure Adjust_Indentation_After_Comma (Tok : Tokn_Cursor)
is
Index : constant Line_Break_Index := Line_Break_Token_Index (Tok);
LB : Line_Break renames All_LB (Index);
Crt_Tok : Tokn_Cursor := Tok;
OP_Count : Natural := 0;
CP_Count : Natural := 0;
begin
pragma Assert (Kind (Tok) in Line_Break_Token and then LB.Enabled);
if not Called_As_Parameter_Of_An_Action_Call (Crt_Tok) then
return;
end if;
-- Look forward on the line after the current ',' followed by a
-- LB and find its specificities in order to adjust the
-- indentation value of the line break.
while not After_Last (Crt_Tok) loop
Next (Crt_Tok);
case Kind (Crt_Tok) is
when Line_Break_Token =>
declare
Crt_Index : constant Line_Break_Index :=
Line_Break_Token_Index (Crt_Tok);
Crt_LB : Line_Break renames All_LB (Crt_Index);
EP : Tokn_Cursor := Nil_Tokn_Cursor;
PLB_Indent : Natural := 0;
begin
if Crt_LB.Enabled
and then Is_Expected_Token (Crt_Tok)
then
EP := Enclosing_Open_Paren (Crt_Tok, OP_Count);
if not Is_Nil (EP) then
PLB_Indent := Prev_LB_Indentation (EP);
-- The context is supposed to be a parenthesized
-- call and the indentation should be alligned
-- to the parenthesis position + 1.
-- The opened and closed parenthesis could
-- impact the alignement. So, will adjust
-- according to the different situations
if OP_Count = 0 and then CP_Count = 0 then
null;
elsif OP_Count /= 0 and then CP_Count = 0 then
LB.Indentation := LB.Indentation - OP_Count;
elsif CP_Count /= 0 and then OP_Count = 0 then
null;
else
if OP_Count = CP_Count then
null;
elsif CP_Count > OP_Count then
LB.Indentation :=
(if CP_Count - OP_Count >= 1 then
(LB.Indentation -
(CP_Count - OP_Count) + 1)
else
LB.Indentation);
elsif OP_Count > CP_Count then
LB.Indentation := LB.Indentation -
(OP_Count - CP_Count);
end if;
end if;
-- This part will handle the last line of the
-- parenthesized call. Sometime, after Split_Line
-- when more than one parenthesis is found in a
-- line and the max length is exceeded, when the
-- line is splitted the indentation is not
-- updated.
if Kind (Prev (Crt_Tok)) = ';'
and then OP_Count /= 0
then
if LB.Indentation /= PLB_Indent + 1 then
LB.Indentation := PLB_Indent + OP_Count + 1;
end if;
end if;
end if;
exit;
end if;
end;
when '(' =>
OP_Count := OP_Count + 1;
when ')' =>
CP_Count := CP_Count + 1;
when others => null;
end case;
end loop;
end Adjust_Indentation_After_Comma;
Saved_New_Tokns : Scanner.Tokn_Vec renames Lines_Data.Saved_New_Tokns;
New_Tokns : Scanner.Tokn_Vec renames Lines_Data.New_Tokns;
Ignore : Boolean := Scanner.Move_Tokns
(Target => Saved_New_Tokns, Source => New_Tokns);
New_Tok : Tokn_Cursor := First (Saved_New_Tokns'Access);
-- Start of processing for Insert_Indentation
begin
pragma Assert (Is_Empty (New_Tokns));
-- Remove all disabled line break tokens, and change
-- Disabled_LB_Token to Enabled_LB_Token if enabled.
-- We remove False_End_Of_Lines here as well.
while not After_Last (New_Tok) loop
case Kind (New_Tok) is
when Line_Break_Token =>
declare
Index : constant Line_Break_Index :=
Line_Break_Token_Index (New_Tok);
LB : Line_Break renames All_LB (Index);
begin
if LB.Enabled then
Append_Line_Break_Tokn
(New_Tokns, Enabled => True, Index => Index);
LB.Tok := Nil_Tokn_Cursor;
-- Tok is no longer needed
end if;
end;
when False_End_Of_Line =>
null;
when True_End_Of_Line =>
pragma Assert (False);
when others =>
Append_Tokn (New_Tokns, New_Tok);
end case;
Next (New_Tok);
end loop;
Scanner.Move_Tokns
(Target => Saved_New_Tokns, Source => New_Tokns);
New_Tok := First (Saved_New_Tokns'Access);
-- Remove Spaces at start or end of line
while not After_Last (New_Tok) loop
case Kind (New_Tok) is
when Spaces =>
if Kind (Prev (New_Tok)) in Line_Break_Token
or else Kind (Next (New_Tok)) in Line_Break_Token
then
goto Skip;
end if;
when EOL_Token => pragma Assert (False);
when others => null;
end case;
Append_Tokn (New_Tokns, New_Tok);
<>
Next (New_Tok);
end loop;
Scanner.Move_Tokns
(Target => Saved_New_Tokns, Source => New_Tokns);
New_Tok := First (Saved_New_Tokns'Access);
-- Insert indentation after each line break that is not immediately
-- followed by another line break (i.e. at the beginning of each
-- nonblank line).
while not After_Last (New_Tok) loop
Append_Tokn (New_Tokns, New_Tok);
if Kind (New_Tok) in Line_Break_Token then
declare
LB : Line_Break renames
All_LB (Line_Break_Token_Index (New_Tok));
pragma Assert (LB.Enabled);
pragma Assert (Kind (Next (New_Tok)) /= Spaces);
begin
-- In case of parenthesized expressions
-- (like function or procedure calls where one of the call
-- param is a function call with multiple parameters), the
-- lines of the call having more than one open parenthesis,
-- the related line breaks indentation computed in the
-- previous steps might need to be adjusted.
if Kind (Prev (New_Tok)) = ',' then
Adjust_Indentation_After_Comma (New_Tok);
end if;
if Kind (Next (New_Tok))
not in Line_Break_Token | End_Of_Input
then
Append_Spaces (New_Tokns, LB.Indentation);
end if;
end;
end if;
Next (New_Tok);
end loop;
if Assert_Enabled then
for LB of All_LB loop
pragma Warnings (Off);
LB := (others => <>);
pragma Warnings (On);
end loop;
end if;
Clear (All_LB);
Clear (Lines_Data.All_LBI);
Assert_No_LB (Lines_Data);
Clear (Saved_New_Tokns);
end Insert_Indentation;
procedure Insert_Alignment_Helper
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line;
Partial_GNATPP : Boolean := False);
-- Expand tabs as necessary to align things
----------------------
-- Insert_Alignment --
----------------------
procedure Insert_Alignment
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line;
Partial_GNATPP : Boolean := False) is
begin
if Alignment_Enabled (Cmd) then
Insert_Alignment_Helper (Lines_Data_P, Cmd, Partial_GNATPP);
end if;
end Insert_Alignment;
-----------------------------
-- Insert_Alignment_Helper --
-----------------------------
procedure Insert_Alignment_Helper
(Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line;
Partial_GNATPP : Boolean := False)
is
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
Initial_Indentation : Natural renames Lines_Data.Initial_Indentation;
Tabs : Tab_Vector renames Lines_Data.Tabs;
Saved_New_Tokns : Scanner.Tokn_Vec renames Lines_Data.Saved_New_Tokns;
New_Tokns : Scanner.Tokn_Vec renames Lines_Data.New_Tokns;
Ignore : constant Boolean :=
Scanner.Move_Tokns (Target => Saved_New_Tokns, Source => New_Tokns);
package Paragraphs_Maps is new
Ada.Containers.Indefinite_Hashed_Maps
(Key_Type => Ada_Node,
Element_Type => Tab_In_Line_Vector_Vectors.Vector,
Hash => Libadalang.Analysis.Hash,
Equivalent_Keys => Libadalang.Analysis."=",
"=" => Tab_In_Line_Vector_Vectors."=");
subtype Paragraphs_Map is Paragraphs_Maps.Map;
All_Paragraphs : Paragraphs_Map;
-- Because lines are processed one by one, we must cache paragraphs
-- in case we need to continue with one after lines that do not
-- match with the previous one.
-- Example:
--
-- Some_Subprogram_Call
-- (First_Parameter =>
-- First_Parameter_Value,
-- Second_Parameter =>
-- Frist_Parameter_Value);
--
-- The arrow after First_Parameter must be aligned with the arrow
-- after Second_Parameter. However, there is a line with
-- First_Parameter_Value between them, therefore, the a different
-- paragraph after First_Parameter.
-- This map enables use to reuse the First_Parameter paragraph
-- when processing the Second_Parameter paragraph.
procedure Assign_Insertion_Points;
-- Assign the Insertion_Point component of each Tab_Rec to point to
-- the corresponding token in Saved_New_Tokns.
procedure Calculate_Num_Blanks;
-- Compute the number of spaces that need to be inserted for each
-- tab.
procedure Do_Insertions;
-- Do the actual insertions of spaces, based on the computation done
-- by Calculate_Num_Blanks.
-----------------------------
-- Assign_Insertion_Points --
-----------------------------
procedure Assign_Insertion_Points is
New_Tok : Tokn_Cursor := First (Saved_New_Tokns'Access);
begin
while not After_Last (New_Tok) loop
if Kind (New_Tok) = Tab_Token then
Tabs (Tab_Token_Index (New_Tok)).Insertion_Point :=
New_Tok;
end if;
Next (New_Tok);
end loop;
-- Make sure last (sentinel) tab has an Insertion_Point that is
-- after any others.
Tabs (Last_Index (Tabs)).Insertion_Point :=
Last (Saved_New_Tokns'Access);
end Assign_Insertion_Points;
--------------------------
-- Calculate_Num_Blanks --
--------------------------
procedure Calculate_Num_Blanks is
-- Note on Col and Num_Blanks components of Tab_Rec:
-- Col is initialized to a bogus value, and Num_Blanks to 0.
-- Process_Line sets Col to the correct value. Flush_Para uses
-- Col, and possibly changes Num_Blanks to some positive value.
-- After the call to Calculate_Num_Blanks, Num_Blanks is used to
-- insert the correct number of ' ' characters. Thus, Col is
-- temporary, used only within Calculate_Num_Blanks, to
-- communicate information from Process_Line to Flush_Paragraphs.
Paragraph_Tabs : Tab_In_Line_Vector_Vectors.Vector;
-- One Tab_In_Line_Vector for each line in the current paragraph
Allow_Joining_Paragraphs : Boolean := True;
New_Tok : Tokn_Cursor := First (Saved_New_Tokns'Access);
Cur_Tab_Index : Tab_Index := 1;
First_Line_Tabs, Cur_Line_Tabs : Tab_In_Line_Vector;
-- Tabs for first line of paragraph and for current line.
-- Tabs are represented by their index.
procedure Check_Tokens_Match (X, Y : Tab_In_Line_Vector);
-- If two lines come from the same construct, then the tokens
-- should match. Raise an exception if they don't.
function Cur_Tab return Tab_Rec is (Tabs (Cur_Tab_Index));
pragma Assert (not Cur_Tab.Deleted);
procedure Flush_Paragraph
(Paragraph : Tab_In_Line_Vector_Vectors.Vector);
-- Called at the end of a "tabbing paragraph", i.e. a group of one
-- or more lines that each represents similar constructs that
-- should be treated together for alignment purposes.
procedure Flush_Paragraphs;
-- Called at the end of Calculate_Num_Blanks and delegates to
-- Flush_Paragraph for every paragraphs of All_Paragraphs.
procedure Process_Current_Paragraph;
-- Depending if Allow_Joining_Paragraphs and if Paragraph_Tabs
-- parent node has already been seens, processes Paragraph_Tabs
-- or adds it to All_Paragraphs.
procedure Process_Line;
-- Process a single line. Collect together all relevant tabs in
-- Cur_Line_Tabs. All tabs in Cur_Line_Tabs must have the same
-- Tree (that of the first tab on the line). Other tabs (for more
-- nested constructs) are skipped. So for example:
--
-- X : T (Discrim => 123) := (This | That => 345);
--
-- we collect two tabs for ':' and ':=', which have the same Tree
-- (a variable declaration tree). The '|' and '=>' characters in
-- the discriminant constraint and the aggregate also have tabs,
-- but these are skipped, because their Tree is different
-- (more nested).
-- If there are no tabs on the line, then of course Cur_Line_Tabs
-- will be empty. In addition, if we have something like:
--
-- A := (1 | 2 | 3 => ...);
--
-- the '|' and '=>' tabs will have the same Index_In_Line, in
-- which case we give up (set Tab_Mismatch to True, and set
-- Cur_Line_Tabs to empty). Those tabs are only of use if we end
-- up enabling line breaks after the '|'s.
--
--
-- ------------------------------
-- Handling of "insertion points"
-- ------------------------------
--
-- Let's pretend the template for assignment_statement is
--
-- ! ^:= !
--
-- which means insert the left-hand side, followed by " := ",
-- followed by the right-hand side. (It's actually more
-- complicated; this is just an example.) There is a tab before
-- ":=", so multiple assignment_statements line up like this:
--
-- Long_Name := 1;
-- X := 10_000;
-- Even_Longer_Name := 1_000_000;
--
-- If we add a tab at the end (just before the ";"): "! ^:= !^2",
-- we get this:
--
-- Long_Name := 1 ;
-- X := 10_000 ;
-- Even_Longer_Name := 1_000_000;
--
-- If in addition we add an insertion point before the right-hand
-- side, so the template is: "! ^:= &2!^2", then the blanks are
-- inserted before the right-hand side, resulting in
-- right-justified expressions:
--
-- Long_Name := 1;
-- X := 10_000;
-- Even_Longer_Name := 1_000_000;
--
-- (We currently do not right-justify those expressions; this is
-- just an example to show how "&" works. "&" is actually used in
-- Do_Component_Clause.)
procedure Put_Paragraph
(Paragraph : Tab_In_Line_Vector_Vectors.Vector);
procedure Put_Tab_In_Line_Vector
(Name : String;
X : Tab_In_Line_Vector);
------------------------
-- Check_Tokens_Match --
------------------------
procedure Check_Tokens_Match (X, Y : Tab_In_Line_Vector) is
begin
pragma Assert (not Is_Empty (X) and then not Is_Empty (Y));
for J in 1 .. Last_Index (X) loop
declare
XX : constant Tab_Index := X (J);
YY : constant Tab_Index := Y (J);
XT : constant Symbol := Tabs (XX).Token;
YT : constant Symbol := Tabs (YY).Token;
begin
if XT /= YT then
-- "=>" matches a preceding "|", and vice versa
if (XT = Name_Arrow and then YT = Name_Bar)
or else (XT = Name_Bar and then YT = Name_Arrow)
then
null;
else
Put_Token (New_Tok);
raise Program_Error with
"Tab token mismatch: " &
Str (XT).S & " " & Str (YT).S;
end if;
end if;
end;
end loop;
end Check_Tokens_Match;
---------------------
-- Flush_Paragraph --
---------------------
procedure Flush_Paragraph
(Paragraph : Tab_In_Line_Vector_Vectors.Vector)
is
Num_Lines : constant Tab_In_Line_Vector_Index'Base :=
Last_Index (Paragraph);
begin
-- Here we have Paragraph set to a sequence of lines (or the
-- tabs in those lines, really). For example, if the input text
-- was (*1):
--
-- package P is
--
-- X : T := 1;
-- A_Long_Variable_Name : T := 2;
-- Y : A_Long_Type_Name := 3;
--
-- end P;
-- ^
-- |
-- column 1
--
-- then previous passes will have turned that into (*2):
--
-- package P is
--
-- X ^1: T ^2:= 1;
-- A_Long_Variable_Name ^1: T ^2:= 2;
-- Y ^1: A_Long_Type_Name ^2:= 3;
--
-- end P;
--
-- The tabs are shown as ^1 and ^2 in (*2) above, although they
-- are really kept in a separate data structure (Tabs) rather
-- than in the text itself, and take up zero columns in the
-- buffer.
-- The "paragraph" we're talking about consists of the three
-- variable-declaration lines. Note that the alignment from the
-- input has been forgotten; we would get the same thing if the
-- input were unaligned. Our job is to align the ":" and ":="
-- symbols, whether or not they were originally aligned.
--
-- ^1 means Index_In_Line = 1; ^2 means Index_In_Line = 2 (see
-- type Tab_Rec). The Col of each tab is currently set to the
-- column in which it appears in (*2), and the Num_Blanks is
-- currently set to 0. The following code sets the Col of each
-- tab to the column in which it WILL appear, and the
-- Num_Blanks to the number of blanks to expand the tab to in
-- order to achieve that.
--
-- We first loop through all the ^1 tabs, and calculate the max
-- Col, which will be the ":" of the A_Long_Variable_Name line.
-- We then loop through those again, and set the Num_Blanks to
-- be the number of blanks needed to reach that max column. For
-- each such ^1 tab, we loop from that ^1, through ^2 and ^3
-- and so on (we have no ^3... in this example), adjusting
-- their Col accordingly.
--
-- Then we loop through all the ^2 tabs in the same way, and so
-- on for ^3, etc.
--
-- So in this example, we loop down through the ^1 tabs to
-- calculate where to put the ":"'s. Then down through the ^1
-- tabs again to adjust the Num_Blanks for the ^1 tabs, and
-- loop accross to adjust the Col for the ^1 and ^2 tabs. Then
-- down through the ^2 tabs to calculate where to put the
-- ":="'s.
--
-- Then down through the ^2 tabs to adjust the Num_Blanks for
-- the ^2 tabs, and loop across to adjust the Col for the ^2
-- tabs.
-- Note that adjusting the Col for the ":"'s affects where
-- we're going to put the ":="'s -- that's the reason for the
-- "loop across" part.
--
-- The end result is to calculate the Num_Blanks so that when
-- we expand the tabs, (*2) above will be turned (back) into
-- the (*1).
-- We must not process a zero-line paragraph. For efficiency,
-- we can avoid processing a one-line paragraph (leaving all
-- tabs, if any with Num_Blanks = 0). Multi-line paragraphs
-- always have at least one tab per line, and all lines have
-- the same number of tabs.
if Num_Lines < 2 then
return;
end if;
pragma Debug (Put_Paragraph (Paragraph));
pragma Assert (Last_Index (Paragraph (1)) /= 0);
for Index_In_Line in 1 .. Last_Index (Paragraph (1)) loop
declare
Max_Col : Positive := 1;
begin
for Line of Paragraph loop
if Index_In_Line <= Last_Index (Line) then
declare
Tab_I : constant Tab_Index :=
Line (Index_In_Line);
Tab : Tab_Rec renames Tabs (Tab_I);
begin
Max_Col := Positive'Max (Max_Col, Tab.Col);
end;
end if;
end loop;
for Line of Paragraph loop
if Index_In_Line <= Last_Index (Line) then
declare
Tab_I : constant Tab_Index :=
Line (Index_In_Line);
Tab : Tab_Rec renames Tabs (Tab_I);
begin
if Tab.Is_Fake then
Tab.Col := Max_Col;
end if;
Tab.Num_Blanks := Max_Col - Tab.Col;
pragma Assert
(if Tab.Is_Fake then Tab.Num_Blanks = 0);
for X_In_Line in
Index_In_Line .. Last_Index (Line)
loop
declare
Tab_J : constant Tab_Index :=
Line (X_In_Line);
Tab_2 : Tab_Rec renames Tabs (Tab_J);
begin
Tab_2.Col := Tab_2.Col + Tab.Num_Blanks;
end;
end loop;
pragma Assert (Tab.Col = Max_Col);
pragma Assert
(if Num_Lines = 1 then Tab.Num_Blanks = 0);
-- Because of that fact, we can skip all this
-- for 1-line paragraphs.
end;
end if;
end loop;
end;
end loop;
pragma Debug (Put_Paragraph (Paragraph));
end Flush_Paragraph;
----------------------
-- Flush_Paragraphs --
----------------------
procedure Flush_Paragraphs is
Num_Lines : Tab_In_Line_Vector_Index'Base;
All_Paragraphs_Cursor : Paragraphs_Maps.Cursor :=
All_Paragraphs.First;
begin
while Paragraphs_Maps.Has_Element (All_Paragraphs_Cursor) loop
Num_Lines :=
Last_Index
(Paragraphs_Maps.Element (All_Paragraphs_Cursor));
if Num_Lines > 1 then
pragma Debug
(Put_Paragraph
(Paragraphs_Maps.Element
(All_Paragraphs_Cursor)));
pragma
Assert
(Last_Index
(Paragraphs_Maps.Element
(All_Paragraphs_Cursor) (1)) /= 0);
for Index_In_Line in
1 .. Last_Index
(Paragraphs_Maps.Element
(All_Paragraphs_Cursor) (1))
loop
declare
Max_Col : Positive := 1;
begin
for Line of
Paragraphs_Maps.Element (All_Paragraphs_Cursor)
loop
if Index_In_Line <= Last_Index (Line) then
declare
Tab_I : constant Tab_Index :=
Line (Index_In_Line);
Tab : Tab_Rec renames Tabs (Tab_I);
begin
Max_Col := Positive'Max (Max_Col, Tab.Col);
end;
end if;
end loop;
for Line of
Paragraphs_Maps.Element (All_Paragraphs_Cursor)
loop
if Index_In_Line <= Last_Index (Line) then
declare
Tab_I : constant Tab_Index :=
Line (Index_In_Line);
Tab : Tab_Rec renames Tabs (Tab_I);
begin
if Tab.Is_Fake then
Tab.Col := Max_Col;
end if;
Tab.Num_Blanks := Max_Col - Tab.Col;
pragma Assert
(if Tab.Is_Fake then Tab.Num_Blanks = 0);
for X_In_Line in
Index_In_Line .. Last_Index (Line)
loop
declare
Tab_J : constant Tab_Index :=
Line (X_In_Line);
Tab_2 : Tab_Rec renames Tabs (Tab_J);
begin
Tab_2.Col :=
Tab_2.Col + Tab.Num_Blanks;
end;
end loop;
pragma Assert (Tab.Col = Max_Col);
pragma Assert
(if Num_Lines = 1 then
Tab.Num_Blanks = 0);
-- Because of that fact, we can skip all
-- this for 1-line paragraphs.
end;
end if;
end loop;
end;
end loop;
end if;
Paragraphs_Maps.Next (All_Paragraphs_Cursor);
end loop;
end Flush_Paragraphs;
------------------
-- Process_Line --
------------------
procedure Process_Line is
Tab_Mismatch : Boolean := False;
First_Time : Boolean := True;
Tree : Ada_Node := Libadalang.Analysis.No_Ada_Node;
begin
while Kind (New_Tok) not in End_Of_Input | Enabled_LB_Token loop
-- Iterate this line tokens until New_Tok is preceded by a
-- tab.
-- We can have two tabs at the same place if the second one
-- is fake. Also for implicit 'in' mode, etc. Hence 'while',
-- not 'if' here.
while Cur_Tab.Insertion_Point = New_Tok loop
pragma Assert (not Cur_Tab.Deleted);
if First_Time then
pragma Assert (Is_Empty (Cur_Line_Tabs));
First_Time := False;
Tree := Cur_Tab.Tree;
end if;
if Cur_Tab.Tree = Tree then
-- Ignore if too many tabs in one line
if not Cur_Tab.Is_Insertion_Point
and then Last_Index (Cur_Line_Tabs) <
Tab_Index_In_Line'Last
then
Append (Cur_Line_Tabs, Cur_Tab_Index);
if Cur_Tab.Index_In_Line /=
Last_Index (Cur_Line_Tabs)
then
Tab_Mismatch := True;
else
Tab_Mismatch := False;
end if;
Tabs (Cur_Tab_Index).Col := Sloc (New_Tok).Col;
end if;
end if;
-- Skip all deleted and fake tabs
loop
Cur_Tab_Index := Cur_Tab_Index + 1;
exit when not Cur_Tab.Deleted;
end loop;
end loop;
Next_ss (New_Tok);
end loop;
if Tab_Mismatch then
Clear (Cur_Line_Tabs);
end if;
end Process_Line;
-------------------------------
-- Process_Current_Paragraph --
-------------------------------
procedure Process_Current_Paragraph is
begin
if not Paragraph_Tabs.Is_Empty
and then not Is_Empty (Last_Element (Paragraph_Tabs))
then
declare
use Libadalang.Common;
Tab : constant Tab_Rec :=
Tabs (Last_Element (Last_Element (Paragraph_Tabs)));
Parent : constant Ada_Node := Tab.Parent;
Last_Tab : Tab_Rec;
begin
if All_Paragraphs.Contains (Parent) then
Last_Tab :=
Tabs
(Last_Element
(Last_Element
(All_Paragraphs.Element (Parent))));
if not Tab.Tree.Is_Null
and then not Last_Tab.Tree.Is_Null
and then Tab.Tree.Kind = Last_Tab.Tree.Kind
and then not Last_Tab.Tree.Next_Sibling.Is_Null
and then Last_Tab.Tree.Next_Sibling.Kind =
Tab.Tree.Kind
and then (Allow_Joining_Paragraphs or else
Tab.Tree.Kind in
Ada_Case_Stmt_Alternative_Range)
then
for Line of Paragraph_Tabs loop
All_Paragraphs.Reference (Parent).Append (Line);
end loop;
else
-- Flush the previously seen paragraph,
-- replace it by the new one and allow
-- joining paragraphs again.
Flush_Paragraph (All_Paragraphs.Reference (Parent));
All_Paragraphs.Replace (Parent, Paragraph_Tabs);
Allow_Joining_Paragraphs := True;
end if;
else
All_Paragraphs.Include (Parent, Paragraph_Tabs);
Allow_Joining_Paragraphs := True;
end if;
Clear (Paragraph_Tabs);
end;
end if;
end Process_Current_Paragraph;
-------------------
-- Put_Paragraph --
-------------------
procedure Put_Paragraph
(Paragraph : Tab_In_Line_Vector_Vectors.Vector) is
begin
Dbg_Out.Put
("\1 Put_Paragraph\n",
Image (Integer (Last_Index (Paragraph))));
for X of Paragraph loop
Put_Tab_In_Line_Vector ("", X);
end loop;
Dbg_Out.Put ("end Put_Paragraph\n");
end Put_Paragraph;
----------------------------
-- Put_Tab_In_Line_Vector --
----------------------------
procedure Put_Tab_In_Line_Vector
(Name : String;
X : Tab_In_Line_Vector)
is
pragma Unreferenced (Name);
begin
if Is_Empty (X) then
return;
end if;
-- Dbg_Out.Put ("\1: \t", Name);
--
-- for J in 1 .. Last_Index (X) loop
-- if J /= 1 then
-- Dbg_Out.Put ("; ");
-- end if;
-- Dbg_Out.Put ("\1", Tab_Image (Out_Buf, Tabs, X (J)));
-- end loop;
-- Dbg_Out.Put ("\n");
end Put_Tab_In_Line_Vector;
F_Tab, C_Tab : Tab_Rec;
-- Start of processing for Calculate_Num_Blanks
begin
-- Debug printouts commented out for efficiency
while Kind (New_Tok) /= End_Of_Input loop
declare
-- First_Char_In_Line : constant Natural :=
-- Sloc (New_Tok).First - Sloc (New_Tok).Col + 1;
begin
Process_Line;
-- Dbg_Out.Put ("<<");
-- for X in First_Char_In_Line ..
-- Sloc (New_Tok).First - 1
-- loop
-- for Tab of Cur_Line_Tabs loop
-- if X = Position (Out_Buf, Tabs (Tab).Mark) then
-- Dbg_Out.Put ("^");
-- end if;
-- end loop;
-- Dbg_Out.Put
-- ("\1", To_UTF8 ((1 => Char_At (Out_Buf, X))));
-- end loop;
-- Dbg_Out.Put (">>\n");
-- Put_Tab_In_Line_Vector ("First", First_Line_Tabs);
-- Put_Tab_In_Line_Vector ("Cur", Cur_Line_Tabs);
-- Consume the newline
if Is_Empty (Cur_Line_Tabs) then
Process_Current_Paragraph;
-- Leave tabs from this line with Num_Blanks = 0.
Clear (First_Line_Tabs);
else
if Is_Empty (First_Line_Tabs) then
First_Line_Tabs := Cur_Line_Tabs;
else
-- If the Parents don't match, we're at the end of a
-- paragraph. We also end the paragraph if the
-- line-tab arrays are of different length, which can
-- only happen if a comment occurs in the middle of a
-- tabable construct (e.g. before ":=" in a variable
-- declaration), thus forcing a tab onto the next
-- line.
F_Tab := Element (Tabs, First_Line_Tabs (1));
C_Tab := Element (Tabs, Cur_Line_Tabs (1));
if C_Tab.Parent = F_Tab.Parent
and then
Last_Index (Cur_Line_Tabs) =
Last_Index (First_Line_Tabs)
then
pragma Debug
(Check_Tokens_Match
(Cur_Line_Tabs,
First_Line_Tabs));
else
-- Dbg_Out.Put ("Flush_Para -- parent mismatch\n");
Process_Current_Paragraph;
First_Line_Tabs := Cur_Line_Tabs;
end if;
pragma Warnings (Off);
F_Tab := (others => <>);
C_Tab := (others => <>);
pragma Warnings (On);
end if;
Append (Paragraph_Tabs, Cur_Line_Tabs);
Clear (Cur_Line_Tabs);
end if;
if Kind (New_Tok) in Enabled_LB_Token
and then Kind (Prev (New_Tok)) in Enabled_LB_Token
then
Allow_Joining_Paragraphs := False;
end if;
if Partial_GNATPP and then Kind (New_Tok) = End_Of_Input then
-- In order to avoid constraint errors, in partial
-- gnatpp mode, when a selection needs to be reformatted
-- the end of input might be reached after process line
-- and no next token is present.
null;
else
Next_ss (New_Tok);
end if;
-- This is to handle last line of the selection in partial
-- mode and compute accurately the alignment spaces.
if Partial_GNATPP and then Kind (New_Tok) = End_Of_Input then
Set_Length (Cur_Line_Tabs, 0);
-- Recompute the tabs taking into account all the lines,
-- namely the last line which in case of the partial
-- formatting might be omitted.
Process_Current_Paragraph;
Append (Paragraph_Tabs, Cur_Line_Tabs);
Clear (First_Line_Tabs);
Clear (Cur_Line_Tabs);
end if;
end;
-- Dbg_Out.Put ("\n");
end loop;
Flush_Paragraphs;
pragma Assert (Cur_Tab_Index = Last_Index (Tabs));
end Calculate_Num_Blanks;
-------------------
-- Do_Insertions --
-------------------
procedure Do_Insertions is
-- Go through the tokens, inserting Spaces for tabs that should
-- be expanded. Don't expand a tab if it would make the line too
-- long. Remove the Tab_Tokens from the token sequence.
New_Tok : Tokn_Cursor := First (Saved_New_Tokns'Access);
Next_Line_Break : Tokn_Cursor := Next (New_Tok);
-- Sloc_Col of this is the length of the current line, not
-- counting any spaces we have inserted.
pragma Assert (Kind (Next_Line_Break) = Enabled_LB_Token);
Num_Spaces : Natural := 0;
-- Number of spaces inserted in the current line so far
Cur_Line_Num : Positive := 1; -- for errors
begin
Check_Comment_Length := False;
while not After_Last (New_Tok) loop
case Kind (New_Tok) is
when Enabled_LB_Token =>
Cur_Line_Num := Cur_Line_Num + 1;
Error_Sloc := (Slocs.Line_Number (Cur_Line_Num), 1);
Num_Spaces := 0;
pragma Assert (New_Tok = Next_Line_Break);
loop
Next (Next_Line_Break);
exit when Kind (Next_Line_Break) in
Enabled_LB_Token | End_Of_Input;
end loop;
when Tab_Token =>
declare
Tab_X : constant Tab_Index := Tab_Token_Index (New_Tok);
Tab : Tab_Rec renames Tabs (Tab_X);
Next_Tab : Tab_Rec renames Tabs (Tab_X + 1);
begin
if not Tab.Deleted then
-- If Tab is an insertion point, then the very next
-- tab is the corresponding "real" tab; take its
-- Num_Blanks.
if Tab.Is_Insertion_Point then
pragma Assert (Tab.Num_Blanks = 0);
Tab.Num_Blanks := Next_Tab.Num_Blanks;
Next_Tab.Num_Blanks := 0;
end if;
declare
Line_Len : constant Natural :=
Sloc_Col (Next_Line_Break) + Num_Spaces - 1;
-- Current length of current line
New_Line_Len : constant Natural :=
Line_Len
+ Tab.Num_Blanks
+ Initial_Indentation;
-- Length the current line will be after we
-- expand this tab. Don't do it if it will be
-- too long.
begin
if New_Line_Len <= Arg (Cmd, Max_Line_Length) then
Append_Spaces
(New_Tokns, Count => Tab.Num_Blanks,
Existing_OK => True);
Num_Spaces := Num_Spaces + Tab.Num_Blanks;
end if;
end;
end if;
end;
goto Skip_Append;
when Disabled_LB_Token => pragma Assert (False);
when others => null;
end case;
Append_Tokn (New_Tokns, New_Tok);
<>
Next (New_Tok);
end loop;
Check_Comment_Length := True;
end Do_Insertions;
-- Start of processing for Insert_Alignment_Helper
begin
Assign_Insertion_Points;
-- Go through the tabs and set their Num_Blanks field to the
-- appropriate value. Tabs that are not expanded at all will
-- have Num_Blanks left equal to zero.
pragma Debug
(Format_Debug_Output (Lines_Data, "before Calculate_Num_Blanks"));
Calculate_Num_Blanks;
pragma Debug
(Format_Debug_Output (Lines_Data, "after Calculate_Num_Blanks"));
-- Then do the actual insertions
Do_Insertions;
Clear (Saved_New_Tokns);
Clear (Tabs);
end Insert_Alignment_Helper;
-----------------
-- Insert_Tabs --
-----------------
procedure Insert_Tabs (Lines_Data_P : Lines_Data_Ptr;
Cmd : Command_Line)
is
Lines_Data : Lines_Data_Rec renames Lines_Data_P.all;
New_Tokns : Scanner.Tokn_Vec renames Lines_Data.New_Tokns;
Saved_New_Tokns : Scanner.Tokn_Vec renames Lines_Data.Saved_New_Tokns;
Tabs : Tab_Vector renames Lines_Data.Tabs;
-- Copy over New_Tokns to Saved_New_Tokns to iterate and create the
-- New_Tokns buffer
Ignore : Boolean := Scanner.Move_Tokns
(Target => Saved_New_Tokns, Source => New_Tokns);
New_Tok : Tokn_Cursor := First (Saved_New_Tokns'Access);
Tab_Size : constant Positive := PP_Indentation (Cmd);
Tabs_Nb : Integer := 0;
Spaces_Nb : Integer := 0;
procedure Insert_Tab (Col_Nb : Positive;
Tab_Size : Natural;
Idx : Natural);
-- Apends a tab toke into the current line at the given Col_Nb, having
-- the Tab_Size specified as nb of spaces and the index in the line
-- corresponds to the given Idx
procedure Insert_Tab (Col_Nb : Positive;
Tab_Size : Natural;
Idx : Natural)
is
Tab : Tab_Rec := Tab_Rec'
(Parent | Tree => Libadalang.Analysis.No_Ada_Node,
others => <>);
begin
Tab.Index_In_Line := Tab_Index_In_Line (Idx);
Tab.Col := Col_Nb;
Tab.Num_Blanks := Tab_Size;
Tab.Is_Fake := False;
Tab.Is_Insertion_Point := True;
Append (Tabs, Tab);
Append_Tab_Tokn (New_Tokns, Last_Index (Tabs), Tab_Size);
end Insert_Tab;
-- Start of Insert_Tabs
begin
pragma Assert (Is_Empty (New_Tokns));
while not After_Last (New_Tok) loop
case Kind (New_Tok) is
when Spaces =>
if Tokn_Length (New_Tok) >= Tab_Size
and then Sloc_Col (New_Tok) = 1
then
-- Replace spaces in the indentation either by
-- * only tabs when n*tabs_nb == spaces
-- * a mix of tabs and spaces when n*tabs_nb /= spaces
Tabs_Nb := Tokn_Length (New_Tok) / Tab_Size;
Spaces_Nb := Tokn_Length (New_Tok) mod Tab_Size;
declare
Col : constant Positive := Sloc_Col (New_Tok);
Crt_Col : Positive := Col;
begin
-- Adds the needed tabs
if Tabs_Nb /= 0 then
for Idx in 1 .. Tabs_Nb loop
Insert_Tab (Crt_Col, Tab_Size, Idx);
Crt_Col := Crt_Col + Tab_Size - 1;
end loop;
-- Adds spaces if it is about a mix of tabs & spaces
if Spaces_Nb /= 0 then
Append_Spaces (New_Tokns, Count => Spaces_Nb);
end if;
end if;
end;
else
Append_Tokn (New_Tokns, New_Tok);
end if;
when others =>
Append_Tokn (New_Tokns, New_Tok);
end case;
Next (New_Tok);
end loop;
Clear (Saved_New_Tokns);
end Insert_Tabs;
end Tok_Phases;
end Pp.Formatting;