------------------------------------------------------------------------------
-- --
-- Libadalang Tools --
-- --
-- Copyright (C) 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.Assertions;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib;
with GNAT.Strings;
with GNATCOLL.Opt_Parse; use GNATCOLL.Opt_Parse;
with GNATCOLL.Projects;
with Langkit_Support.Slocs; use Langkit_Support.Slocs;
with Libadalang.Analysis; use Libadalang.Analysis;
with Libadalang.Helpers; use Libadalang.Helpers;
with Pp.Command_Lines;
with Pp.Scanner;
with Utils.Char_Vectors;
with Utils.Command_Lines;
with Utils.Command_Lines.Common;
with Laltools.Partial_GNATPP;
-- This procedure defines the partial gnatpp formatting tool
-- Usage:
-- partial_gnatpp -S -SL -EL
-- -SC -EC
--
-- -S, --source-file Source code file of the selection to reformat
-- -SL, --start-line Line of the first statement to extract
-- -EL, --end-line Line of the last statement to extract
-- -SC, --start-column Column of the first statement to extract
-- -EC, --end-column Column of the last statement to extract
procedure Partial_GNATpp is
procedure Partial_GNATpp_App_Setup
(Context : App_Context;
Jobs : App_Job_Context_Array);
package Partial_GNATpp_App is new Libadalang.Helpers.App
(Name => "Partial_GNATpp",
Description => "Partial_GNATpp",
App_setup => Partial_GNATpp_App_Setup);
package Args is
package Source is new GNATCOLL.Opt_Parse.Parse_Option
(Parser => Partial_GNATpp_App.Args.Parser,
Short => "-S",
Long => "--source-file",
Help => "Source code file of the selection",
Arg_Type => Unbounded_String,
Convert => To_Unbounded_String,
Default_Val => Null_Unbounded_String,
Enabled => True);
package Start_Line is new GNATCOLL.Opt_Parse.Parse_Option
(Parser => Partial_GNATpp_App.Args.Parser,
Short => "-SL",
Long => "--start-line",
Help => "Start line",
Arg_Type => Natural,
Convert => Natural'Value,
Default_Val => 1,
Enabled => True);
package Start_Column is new GNATCOLL.Opt_Parse.Parse_Option
(Parser => Partial_GNATpp_App.Args.Parser,
Short => "-SC",
Long => "--start-column",
Help => "Start column",
Arg_Type => Natural,
Convert => Natural'Value,
Default_Val => 1,
Enabled => True);
package End_Line is new GNATCOLL.Opt_Parse.Parse_Option
(Parser => Partial_GNATpp_App.Args.Parser,
Short => "-EL",
Long => "--end-line",
Help => "End line",
Arg_Type => Natural,
Convert => Natural'Value,
Default_Val => 1,
Enabled => True);
package End_Column is new GNATCOLL.Opt_Parse.Parse_Option
(Parser => Partial_GNATpp_App.Args.Parser,
Short => "-EC",
Long => "--end-column",
Help => "End column",
Arg_Type => Natural,
Convert => Natural'Value,
Default_Val => 1,
Enabled => True);
package Source_Line_Breaks is new GNATCOLL.Opt_Parse.Parse_Flag
(Parser => Partial_GNATpp_App.Args.Parser,
Long => "--source-line-breaks",
Help => "Take line breaks only from source",
Enabled => True);
end Args;
--------------------------------
-- Partial_GNATpp_App_Setup --
--------------------------------
procedure Partial_GNATpp_App_Setup
(Context : App_Context;
Jobs : App_Job_Context_Array)
is
use Pp.Command_Lines;
use Utils.Command_Lines;
use Laltools.Partial_GNATPP;
procedure Setup_Pretty_Printer_Switches;
-- Setups PP_Options by doing the first pass and then checks if this
-- project has a "Pretty_Printer" package with additional switches.
-- If so, do a second and final parse to update PP_Options with these.
Source_File : constant String := To_String (Args.Source.Get);
Selection_Range : constant Source_Location_Range :=
(Line_Number (Args.Start_Line.Get),
Line_Number (Args.End_Line.Get),
Column_Number (Args.Start_Column.Get),
Column_Number (Args.End_Column.Get));
Unit : constant Analysis_Unit :=
Jobs (1).Analysis_Ctx.Get_From_File (Source_File);
PP_Options : Command_Line (Pp.Command_Lines.Descriptor'Access);
-----------------------------------
-- Setup_Pretty_Printer_Switches --
-----------------------------------
procedure Setup_Pretty_Printer_Switches is
Dummy : GNAT.Strings.String_List_Access :=
new GNAT.Strings.String_List (1 .. 0);
begin
Parse
(Dummy,
PP_Options,
Phase => Cmd_Line_1,
Callback => null,
Collect_File_Names => False,
Ignore_Errors => True);
GNAT.OS_Lib.Free (Dummy);
-- If Context.Provider.Kind is in Project_File, it means that a
-- project was given by the -P option.
-- Partial_GNATpp_App.Args.Project_File cannot be an empty string
-- in that case.
if Context.Provider.Kind in Project_File then
Ada.Assertions.Assert
(To_String (Partial_GNATpp_App.Args.Project_File.Get) /= "");
-- Set the Project_File option in PP_Options
Utils.Command_Lines.Common.Common_String_Switches.Set_Arg
(PP_Options,
Utils.Command_Lines.Common.Project_File,
To_String (Partial_GNATpp_App.Args.Project_File.Get));
-- Check if this project has a "Pretty_Printer" package with
-- additional switches. If so, do a second and final parse to
-- update PP_Options with these.
declare
use GNATCOLL.Projects;
use GNAT.OS_Lib;
Project : constant Project_Type :=
Root_Project (Context.Provider.Project.all);
PP_Switches : constant Attribute_Pkg_List :=
Build ("Pretty_Printer", "Default_Switches");
PP_Switches_Text : Argument_List_Access := null;
begin
if Has_Attribute (Project, PP_Switches, "ada") then
PP_Switches_Text :=
Attribute_Value (Project, PP_Switches, "ada");
if PP_Switches_Text /= null then
Parse
(PP_Switches_Text,
PP_Options,
Phase => Project_File,
Callback => null,
Collect_File_Names => False,
Ignore_Errors => True);
Free (PP_Switches_Text);
end if;
end if;
end;
end if;
end Setup_Pretty_Printer_Switches;
begin
Setup_Pretty_Printer_Switches;
if Args.Source_Line_Breaks.Get then
-- Format the selected range of the text. If the --source-line-breaks
-- switch is passed then the formetted text will be filtered and only
-- the reformatted initial selected lines will be returned.
-- Otherwise, the enclosing parent node will be rewritten, the node
-- is returned as value of Formatted_Node parameter in this call.
-- This is based on the gnatpp engine and has as entry point the
-- Format_Vector of PP.Actions.
declare
Enclosing_Node : Ada_Node;
Output : Utils.Char_Vectors.Char_Vector;
Output_SL_Range : Source_Location_Range;
Messages : Pp.Scanner.Source_Message_Vector;
begin
Format_Selection
(Main_Unit => Unit,
Input_Selection_Range => Selection_Range,
Output => Output,
Output_Selection_Range => Output_SL_Range,
PP_Messages => Messages,
Formatted_Node => Enclosing_Node,
PP_Options => PP_Options,
Force_Source_Line_Breaks => Args.Source_Line_Breaks.Get);
-- Create the text edits to be passed to the IDE related to the
-- rewritten selection.
declare
Output_Str : constant String :=
Utils.Char_Vectors.Char_Vectors.Elems (Output)
(1 .. Utils.Char_Vectors.Char_Vectors.Last_Index (Output));
Edit : Partial_Formatting_Edit;
begin
Edit := Partial_Formatting_Edit'
(Diagnostics => Messages,
Formatted_Node => Enclosing_Node,
Indentation => 0,
Edit =>
Text_Edit'
(Location => Output_SL_Range,
Text =>
Ada.Strings.Unbounded.To_Unbounded_String
(Output_Str)));
Ada.Text_IO.Put_Line (Image (Edit));
New_Line;
end;
end;
else
Ada.Text_IO.Put_Line
(Image (Format_Selection (Unit, Selection_Range, PP_Options)));
New_Line;
end if;
end Partial_GNATpp_App_Setup;
begin
Partial_GNATpp_App.Run;
end Partial_GNATpp;