Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion source/ada/lsp-ada_completions-end_names.adb
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,7 @@ package body LSP.Ada_Completions.End_Names is
when Libadalang.Common.Ada_Accept_Stmt_With_Stmts_Range =>

return VSS.Strings.To_Virtual_String
(Node.As_Accept_Stmt_With_Stmts.F_Name.Text);
(Node.As_Accept_Stmt_With_Stmts.F_Body_Decl.F_Name.Text);

when Libadalang.Common.Ada_Select_Stmt_Range =>
return "select";
Expand Down
8 changes: 4 additions & 4 deletions source/ada/lsp-ada_completions.adb
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,7 @@ package body LSP.Ada_Completions is
Info : constant Name_Information := Names (Cursor);
Name : constant Libadalang.Analysis.Defining_Name :=
Completion_Maps.Key (Cursor);
Selector : constant Libadalang.Analysis.Single_Tok_Node :=
Selector : constant Libadalang.Analysis.Name :=
Name.P_Relative_Name;
Label : VSS.Strings.Virtual_String;
Canonical : VSS.Strings.Virtual_String;
Expand Down Expand Up @@ -397,15 +397,15 @@ package body LSP.Ada_Completions is
Filename => "",
Buffer => Full,
Rule => Rule);
Pp.Actions.Set_Partial_Gnatpp_Offset (Offset);
Pp.Actions.Set_Partial_GNATPP_Offset (Offset);
Pp.Actions.Format_Vector
(Cmd => Cmd,
Input => Input,
Node => Root (Tmp_Unit),
Output => Output,
Messages => PP_Messages,
Partial_Gnatpp => True);
Pp.Actions.Set_Partial_Gnatpp_Offset (0);
Partial_GNATPP => True);
Pp.Actions.Set_Partial_GNATPP_Offset (0);
exception
when E : others =>
-- Failed to pretty print the snippet, keep the previous
Expand Down
190 changes: 119 additions & 71 deletions source/ada/lsp-ada_contexts.adb
Original file line number Diff line number Diff line change
Expand Up @@ -19,10 +19,15 @@ with Ada.Characters.Handling; use Ada.Characters.Handling;

with GNAT.Strings;

with GNATCOLL.Projects; use GNATCOLL.Projects;
with GNATCOLL.Traces; use GNATCOLL.Traces;
with GNATCOLL.VFS; use GNATCOLL.VFS;

with GPR2.Containers;
with GPR2.Path_Name;
with GPR2.Project.Attribute;
with GPR2.Project.Attribute_Index;
with GPR2.Project.Source;

with VSS.Strings.Conversions;

with URIs;
Expand Down Expand Up @@ -260,7 +265,7 @@ package body LSP.Ada_Contexts is
File : GNATCOLL.VFS.Virtual_File;
Reparse : Boolean := False) return Libadalang.Analysis.Analysis_Unit is
begin
if not Is_Ada_File (Self.Tree, File) then
if not Is_Ada_File (Self.Tree.all, File) then
return Libadalang.Analysis.No_Analysis_Unit;
end if;

Expand Down Expand Up @@ -682,10 +687,10 @@ package body LSP.Ada_Contexts is
------------------

procedure Load_Project
(Self : in out Context;
Tree : not null GNATCOLL.Projects.Project_Tree_Access;
Root : Project_Type;
Charset : String)
(Self : in out Context;
Tree : GPR2.Project.Tree.Object;
Root : GPR2.Project.View.Object;
Charset : String)
is
procedure Update_Source_Files;
-- Update the value of Self.Source_Files
Expand All @@ -697,44 +702,47 @@ package body LSP.Ada_Contexts is
-------------------------

procedure Update_Source_Files is
All_Sources : File_Array_Access :=
Root.Source_Files (Recursive => True);
All_Ada_Sources : File_Array (1 .. All_Sources'Length);
Free_Index : Natural := All_Ada_Sources'First;
begin
-- Iterate through all sources, returning only those that have Ada
-- as language.
for J in All_Sources'Range loop
if Is_Ada_File (Self.Tree, All_Sources (J)) then
All_Ada_Sources (Free_Index) := All_Sources (J);
Free_Index := Free_Index + 1;

procedure Insert_Source (Source : GPR2.Project.Source.Object);
-- Insert Source in Self.Source_Files

-------------------
-- Insert_Source --
-------------------

procedure Insert_Source (Source : GPR2.Project.Source.Object) is
Path : constant Virtual_File := Source.Path_Name.Virtual_File;
begin
if not Self.Source_Files.Contains (Path) then
Self.Source_Files.Include (Path);
end if;
end loop;
end Insert_Source;

Unchecked_Free (All_Sources);
begin
Self.Source_Files.Clear;

for Index in 1 .. Free_Index - 1 loop
Self.Source_Files.Include (All_Ada_Sources (Index));
end loop;
Tree.For_Each_Source
(View => Root,
Action => Insert_Source'Access,
Language => GPR2.Ada_Language,
Externally_Built => True);

Self.Source_Dirs.Clear;
Self.External_Source_Dirs.Clear;

for Dir of Source_Dirs
(Project => Root,
Recursive => True,
Include_Externally_Built => False)
for Dir of Tree.Source_Directories
(View => Root,
Externally_Built => False)
loop
Self.Source_Dirs.Include (Dir);
Self.Source_Dirs.Include (Dir.Virtual_File);
end loop;

for Dir of Source_Dirs
(Project => Root,
Recursive => True,
Include_Externally_Built => True)
Self.External_Source_Dirs.Clear;

for Dir of Tree.Source_Directories
(View => Root,
Externally_Built => True)
loop
Self.External_Source_Dirs.Include (Dir);
Self.External_Source_Dirs.Include (Dir.Virtual_File);
end loop;
end Update_Source_Files;

Expand All @@ -744,39 +752,45 @@ package body LSP.Ada_Contexts is

procedure Pretty_Printer_Setup
is
use type GNAT.Strings.String_Access;
Options : GNAT.Strings.String_List_Access;
Validated : GNAT.Strings.String_List_Access;
Last : Integer;
Default : Boolean;
Index : Integer := 0;
Attribute : GPR2.Project.Attribute.Object;
Values : GPR2.Containers.Value_List;
begin
Root.Switches
(In_Pkg => "Pretty_Printer",
File => GNATCOLL.VFS.No_File,
Language => "ada",
Value => Options,
Is_Default_Value => Default);

-- Initialize an gnatpp command line object
Last := Options'First - 1;
for Item of Options.all loop
if Item /= null
and then Item.all /= ""
then
Last := Last + 1;
end if;
end loop;

Validated := new GNAT.Strings.String_List (Options'First .. Last);
Last := Options'First - 1;
for Item of Options.all loop
if Item /= null
and then Item.all /= ""
then
Last := Last + 1;
Validated (Last) := new String'(Item.all);
if Root.Check_Attribute
(Name => LSP.Common.Pretty_Printer.Switches,
Index => LSP.Common.Ada_Index,
Result => Attribute)
then

-- Fill 'Values' with non empty value

for Value of Attribute.Values loop
declare
Text : constant String := Value.Text;
begin
if Text /= "" then
Values.Append (Text);
Index := Index + 1;
end if;
end;
end loop;

Validated := new GNAT.Strings.String_List (1 .. Index);

if Index > 0 then
Index := Validated'First;
for Text of Values loop
Validated (Index) := new String'(Text);
Index := Index + 1;
end loop;
end if;
end loop;
else
Validated := new GNAT.Strings.String_List (1 .. 0);
end if;

Utils.Command_Lines.Parse
(Validated,
Expand All @@ -786,24 +800,21 @@ package body LSP.Ada_Contexts is
Collect_File_Names => False,
Ignore_Errors => True);

GNAT.Strings.Free (Options);
GNAT.Strings.Free (Validated);

-- Set UTF-8 encoding
Utils.Command_Lines.Common.Set_WCEM (Self.PP_Options, "8");
end Pretty_Printer_Setup;

begin
Self.Id := VSS.Strings.Conversions.To_Virtual_String (Root.Name);
Self.Tree := Tree;
Self.Id := VSS.Strings.Conversions.To_Virtual_String
(String (Root.Name));
Self.Tree := Tree.Reference;
Self.Charset := Ada.Strings.Unbounded.To_Unbounded_String (Charset);

Self.Unit_Provider :=
Libadalang.Project_Provider.Create_Project_Unit_Provider
(Tree => Tree,
Project => Root,
Env => Get_Environment (Root),
Is_Project_Owner => False);
(Tree => Tree, Project => Root);

Self.Event_Handler := Libadalang.Analysis.Create_Event_Handler_Reference
(LSP_Context_Event_Handler_Type'(Trace => Self.Trace));
Expand Down Expand Up @@ -1163,12 +1174,49 @@ package body LSP.Ada_Contexts is

function Project_Attribute_Value
(Self : Context;
Attribute : Attribute_Pkg_String;
Attribute : GPR2.Q_Attribute_Id;
Index : String := "";
Default : String := "";
Use_Extended : Boolean := False) return String
is (if Self.Tree = null then Default
else Root_Project (Self.Tree.all).
Attribute_Value (Attribute, Index, Default, Use_Extended));
is
Attribute_Index : constant GPR2.Project.Attribute_Index.Object :=
(if Index = ""
then GPR2.Project.Attribute_Index.Undefined
else GPR2.Project.Attribute_Index.Create (Index));

Attribute_Value : GPR2.Project.Attribute.Object;

begin
if Self.Tree.Root_Project.Check_Attribute
(Name => Attribute,
Index => Attribute_Index,
Result => Attribute_Value)
then
return Attribute_Value.Value.Text;
elsif Use_Extended and then Self.Tree.Root_Project.Is_Extending then
-- Look at Extended project list as attribute not found in
-- Root_Project and Use_Extended requested.

declare
Extended_Root : GPR2.Project.View.Object :=
Self.Tree.Root_Project.Extended_Root;
begin
while Extended_Root.Is_Defined loop
if Extended_Root.Check_Attribute
(Name => Attribute,
Index => Attribute_Index,
Result => Attribute_Value)
then
return Attribute_Value.Value.Text;
elsif Extended_Root.Is_Extending then
Extended_Root := Extended_Root.Extended_Root;
else
Extended_Root := GPR2.Project.View.Undefined;
end if;
end loop;
end;
end if;
return Default;
end Project_Attribute_Value;

end LSP.Ada_Contexts;
16 changes: 9 additions & 7 deletions source/ada/lsp-ada_contexts.ads
Original file line number Diff line number Diff line change
Expand Up @@ -20,12 +20,14 @@
with Ada.Strings.Unbounded;
with Ada.Strings.UTF_Encoding;

with GNATCOLL.Projects;
with GNATCOLL.Traces;
with GNATCOLL.VFS;

with GNATdoc.Comments.Options;

with GPR2.Project.Tree;
with GPR2.Project.View;

with Langkit_Support.File_Readers; use Langkit_Support.File_Readers;
with Laltools.Common;

Expand Down Expand Up @@ -64,10 +66,10 @@ package LSP.Ada_Contexts is
-- in particular.

procedure Load_Project
(Self : in out Context;
Tree : not null GNATCOLL.Projects.Project_Tree_Access;
Root : GNATCOLL.Projects.Project_Type;
Charset : String);
(Self : in out Context;
Tree : GPR2.Project.Tree.Object;
Root : GPR2.Project.View.Object;
Charset : String);
-- Use the given project tree, and root project within this project
-- tree, as project for this context. Root must be a non-aggregate
-- project tree representing the root of a hierarchy inside Tree.
Expand Down Expand Up @@ -309,7 +311,7 @@ package LSP.Ada_Contexts is

function Project_Attribute_Value
(Self : Context;
Attribute : GNATCOLL.Projects.Attribute_Pkg_String;
Attribute : GPR2.Q_Attribute_Id;
Index : String := "";
Default : String := "";
Use_Extended : Boolean := False) return String;
Expand Down Expand Up @@ -338,7 +340,7 @@ private
-- Indicate that this is a "fallback" context, ie the context
-- holding any file, in the case no valid project was loaded.

Tree : GNATCOLL.Projects.Project_Tree_Access;
Tree : access GPR2.Project.Tree.Object;
-- The loaded project tree: we need to keep a reference to this
-- in order to figure out which files are Ada and which are not.
-- Do not deallocate: this is owned by the Message_Handler.
Expand Down
Loading