Merge remote branch 'origin/master' into edge

Author: automatic-merge

source/gpr/lsp-gpr_documentation.adb

@@ -16,25 +16,36 @@
 ------------------------------------------------------------------------------
 
 with Ada.Characters.Conversions;
+with Ada.Characters.Latin_1;
+with GPR2.Project.Attribute;
+with GPR2.Project.Variable;
 
 with Gpr_Parser.Common;
 
 with GPR2.Project.Registry.Attribute.Description;
 with GPR2.Project.Registry.Pack.Description;
 
+with LSP.GPR_Files.References;
 with LSP.Text_Documents.Langkit_Documents;
 
 with VSS.Strings.Conversions;
 
 package body LSP.GPR_Documentation is
 
    procedure Get_Tooltip_Text
-     (Self         : LSP.GPR_Files.File;
-      Position     : LSP.Structures.Position;
-      Tooltip_Text : out VSS.Strings.Virtual_String) is
+     (Self              : LSP.GPR_Files.File_Access;
+      URI               : LSP.Structures.DocumentUri;
+      Document_Provider : LSP.GPR_Documents.Document_Provider_Access;
+      Position          : LSP.Structures.Position;
+      Tooltip_Text      : out VSS.Strings.Virtual_String) is
       use Gpr_Parser.Common;
 
       package LKD renames LSP.Text_Documents.Langkit_Documents;
+      package FR renames LSP.GPR_Files.References;
+
+      procedure Append_Value (Reference : FR.Reference);
+      --  If gpr parsed without error append to 'Tooltip_Text'
+      --  current variable/attribute value.
 
       Location : constant Gpr_Parser.Slocs.Source_Location :=
                    LSP.GPR_Files.To_Langkit_Location
@@ -49,12 +60,67 @@ package body LSP.GPR_Documentation is
       use GPR2.Project.Registry.Pack.Description;
       use GPR2;
       use Ada.Characters.Conversions;
+
+      ------------------
+      -- Append_Value --
+      ------------------
+
+      procedure Append_Value (Reference : FR.Reference) is
+      begin
+         if Reference.Is_Variable_Reference
+           or else Reference.Is_Attribute_Reference
+         then
+            declare
+               Document : constant LSP.GPR_Documents.Document_Access :=
+                            Document_Provider.Get_Open_Document (URI);
+               use type LSP.GPR_Documents.Document_Access;
+            begin
+               if Document /= null and then not Document.Has_Errors
+               then
+                  if Reference.Is_Variable_Reference then
+                     declare
+                        Variable : constant GPR2.Project.Variable.Object :=
+                                     Document.Get_Variable
+                                       (Root_File => Self,
+                                        Reference => Reference);
+                     begin
+                        if Variable.Is_Defined then
+                           Tooltip_Text.Append
+                             (VSS.Strings.Conversions.To_Virtual_String
+                                (GPR2.Project.Variable.Image (Variable)));
+                        end if;
+                     end;
+                  elsif Reference.Is_Attribute_Reference then
+                     declare
+                        Attribute : constant GPR2.Project.Attribute.Object :=
+                                      Document.Get_Attribute
+                                        (Root_File => Self,
+                                         Reference => Reference);
+                     begin
+                        if Attribute.Is_Defined then
+                           Tooltip_Text.Append
+                             (VSS.Strings.Conversions.To_Virtual_String
+                                (GPR2.Project.Attribute.Image (Attribute)
+                                 & Ada.Characters.Latin_1.CR));
+                        end if;
+                     end;
+                  end if;
+               end if;
+            end;
+         end if;
+      end Append_Value;
+
    begin
 
       Tooltip_Text.Clear;
 
       if Token /= No_Token and then Token.Data.Kind = Gpr_Identifier then
          declare
+            Reference : constant FR.Reference :=
+                          FR.Identifier_Reference
+                            (File            => Self,
+                             Current_Package => Self.Get_Package (Position),
+                             Token           => Token);
             Previous : constant Token_Reference :=
                          Token.Previous (Exclude_Trivia => True);
          begin
@@ -67,14 +133,35 @@ package body LSP.GPR_Documentation is
                             (Self.Get_Package (Position))));
 
                when Gpr_For =>
+                  Append_Value (Reference);
                   Tooltip_Text.Append
                     (VSS.Strings.Conversions.To_Virtual_String
                        (Get_Attribute_Description ((
                         Self.Get_Package (Position),
                         +(Optional_Name_Type (To_String (Token.Text)))))));
 
                when others =>
-                  null;
+                  Append_Value (Reference);
+                  if Reference.Is_Package_Reference then
+                     Tooltip_Text.Append
+                       (VSS.Strings.Conversions.To_Virtual_String
+                          (Get_Package_Description
+                               (Reference.Referenced_Package)));
+                  else
+                     declare
+                        Attribute : constant FR.Attribute_Definition :=
+                                      Reference.Referenced_Attribute;
+
+                        use type FR.Attribute_Definition;
+                     begin
+                        if Attribute /= FR.No_Attribute_Definition then
+                           Tooltip_Text.Append
+                             (VSS.Strings.Conversions.To_Virtual_String
+                                (Get_Attribute_Description
+                                     (Attribute.Name)));
+                        end if;
+                     end;
+                  end if;
                end case;
             end if;
          end;

source/gpr/lsp-gpr_documentation.ads

@@ -17,6 +17,7 @@
 
 --  Subprogram to obtain documentation for packages & attributes.
 
+with LSP.GPR_Documents;
 with LSP.GPR_Files;
 with LSP.Structures;
 
@@ -25,9 +26,11 @@ with VSS.Strings;
 package LSP.GPR_Documentation is
 
    procedure Get_Tooltip_Text
-     (Self         : LSP.GPR_Files.File;
-      Position     : LSP.Structures.Position;
-      Tooltip_Text : out VSS.Strings.Virtual_String);
+     (Self              : LSP.GPR_Files.File_Access;
+      URI               : LSP.Structures.DocumentUri;
+      Document_Provider : LSP.GPR_Documents.Document_Provider_Access;
+      Position          : LSP.Structures.Position;
+      Tooltip_Text      : out VSS.Strings.Virtual_String);
    --  Get all the information needed to produce tooltips (hover and completion
    --  requests)
 

source/gpr/lsp-gpr_documents.adb

@@ -18,8 +18,11 @@
 with Ada.Exceptions;
 
 with GPR2.Message;
+with GPR2.Project.View;
 with GPR2.Source_Reference;
 
+with VSS.Strings.Conversions;
+
 package body LSP.GPR_Documents is
 
    -------------
@@ -113,6 +116,17 @@ package body LSP.GPR_Documents is
       return Self.Has_Messages;
    end Has_Diagnostics;
 
+   ----------------
+   -- Has_Errors --
+   ----------------
+
+   function Has_Errors
+     (Self    : Document)
+      return Boolean is
+   begin
+      return Self.Tree.Log_Messages.Has_Error;
+   end Has_Errors;
+
    ----------------
    -- Initialize --
    ----------------
@@ -206,4 +220,152 @@ package body LSP.GPR_Documents is
       Self.Published_Files_With_Diags := Files;
    end Update_Files_With_Diags;
 
+   ------------------
+   -- Get_Variable --
+   ------------------
+
+   function Get_Variable
+     (Self      : Document'Class;
+      Root_File : LSP.GPR_Files.File_Access;
+      Reference : LSP.GPR_Files.References.Reference)
+      return GPR2.Project.Variable.Object is
+
+      function Variable
+        (View : GPR2.Project.View.Object) return GPR2.Project.Variable.Object;
+
+      function Variable
+        (View : GPR2.Project.View.Object) return GPR2.Project.Variable.Object
+      is
+         Pack : constant GPR2.Package_Id :=
+                  LSP.GPR_Files.References.Referenced_Package (Reference);
+         Name : constant GPR2.Name_Type :=
+                  GPR2.Name_Type
+                    (VSS.Strings.Conversions.To_UTF_8_String
+                       (LSP.GPR_Files.Image
+                          (LSP.GPR_Files.References.Referenced_Variable
+                             (Reference))));
+
+         use type GPR2.Package_Id;
+      begin
+         if Pack = GPR2.Project_Level_Scope then
+            if View.Has_Variables (Name) then
+               return View.Variable (Name);
+            end if;
+         else
+            if View.Has_Variables (Pack, Name) then
+               return View.Variable (Pack, Name);
+            end if;
+         end if;
+         return GPR2.Project.Variable.Undefined;
+      end Variable;
+
+   begin
+      if LSP.GPR_Files.References.Is_Variable_Reference (Reference)
+        and then not Self.Tree.Log_Messages.Has_Error
+      then
+         declare
+            File : constant LSP.GPR_Files.File_Access :=
+                     LSP.GPR_Files.References.Referenced_File
+                       (File      => Root_File,
+                        Reference => Reference);
+            Path : constant GPR2.Path_Name.Object :=
+                     LSP.GPR_Files.Path (File.all);
+            Root : constant GPR2.Project.View.Object := Self.Tree.Root_Project;
+         begin
+            if Root.Path_Name = Path then
+               return Variable (Root);
+            end if;
+            if Root.Is_Extended then
+               declare
+                  Extending : constant GPR2.Project.View.Object :=
+                                Root.Extending;
+               begin
+                  if Extending.Path_Name = Path then
+                     return Variable (Extending);
+                  end if;
+               end;
+            end if;
+            for Import of Root.Imports loop
+               if Import.Path_Name = Path then
+                  return Variable (Import);
+               end if;
+            end loop;
+         end;
+      end if;
+      return GPR2.Project.Variable.Undefined;
+   end Get_Variable;
+
+   -------------------
+   -- Get_Attribute --
+   -------------------
+
+   function Get_Attribute
+     (Self      : Document'Class;
+      Root_File : LSP.GPR_Files.File_Access;
+      Reference : LSP.GPR_Files.References.Reference)
+      return GPR2.Project.Attribute.Object is
+
+      function Attribute
+        (View : GPR2.Project.View.Object) return GPR2.Project.Attribute.Object;
+
+      Attr_Def : constant LSP.GPR_Files.References.Attribute_Definition :=
+                   LSP.GPR_Files.References.Referenced_Attribute (Reference);
+
+      ---------------
+      -- Attribute --
+      ---------------
+
+      function Attribute
+        (View : GPR2.Project.View.Object) return GPR2.Project.Attribute.Object
+      is
+         Result : GPR2.Project.Attribute.Object;
+      begin
+         if View.Check_Attribute
+           (Name   => Attr_Def.Name,
+            Index  => Attr_Def.Index,
+            At_Pos => Attr_Def.At_Pos,
+            Result => Result)
+         then
+            return Result;
+         else
+            return GPR2.Project.Attribute.Undefined;
+         end if;
+      end Attribute;
+
+   begin
+      if LSP.GPR_Files.References.Is_Attribute_Reference (Reference)
+        and then not Self.Tree.Log_Messages.Has_Error
+      then
+         declare
+            File : constant LSP.GPR_Files.File_Access :=
+                     LSP.GPR_Files.References.Referenced_File
+                       (File      => Root_File,
+                        Reference => Reference);
+            Path : constant GPR2.Path_Name.Object :=
+                     LSP.GPR_Files.Path (File.all);
+            Root : constant GPR2.Project.View.Object := Self.Tree.Root_Project;
+         begin
+            if Root.Path_Name = Path then
+               return Attribute (Root);
+            end if;
+            if Root.Is_Extended then
+               declare
+                  Extending : constant GPR2.Project.View.Object :=
+                                Root.Extending;
+               begin
+                  if Extending.Path_Name = Path then
+                     return Attribute (Extending);
+                  end if;
+               end;
+            end if;
+            for Import of Root.Imports loop
+               if Import.Path_Name = Path then
+                  return Attribute (Import);
+               end if;
+            end loop;
+         end;
+      end if;
+      return GPR2.Project.Attribute.Undefined;
+   end Get_Attribute;
+
 end LSP.GPR_Documents;

source/gpr/lsp-gpr_documents.ads

@@ -31,9 +31,12 @@ with GPR2.Log;
 with GPR2.Path_Name;
 with GPR2.Path_Name.Set;
 with GPR2.Project.Tree;
+with GPR2.Project.Attribute;
+with GPR2.Project.Variable;
 
 with LSP.Text_Documents;
 with LSP.GPR_Files;
+with LSP.GPR_Files.References;
 with LSP.Structures;
 with LSP.Tracers;
 
@@ -91,6 +94,11 @@ package LSP.GPR_Documents is
    function Has_Diagnostics
      (Self : Document)
       return Boolean;
+   --  Returns True when messages found during document parsing.
+
+   function Has_Errors
+     (Self : Document)
+      return Boolean;
    --  Returns True when errors found during document parsing.
 
    -----------------------
@@ -125,6 +133,22 @@ package LSP.GPR_Documents is
    procedure Update_Files_With_Diags
      (Self : in out Document'Class; Files : GPR2.Path_Name.Set.Object);
 
+   function Get_Variable
+     (Self      : Document'Class;
+      Root_File : LSP.GPR_Files.File_Access;
+      Reference : LSP.GPR_Files.References.Reference)
+      return GPR2.Project.Variable.Object;
+   --  if Document contains a valid Tree & Reference is a variable reference
+   --  returns corresponding value otherwise returns 'Undefined'
+
+   function Get_Attribute
+     (Self      : Document'Class;
+      Root_File : LSP.GPR_Files.File_Access;
+      Reference : LSP.GPR_Files.References.Reference)
+      return GPR2.Project.Attribute.Object;
+   --  if Document contains a valid Tree & Reference is an attribute reference
+   --  returns corresponding value otherwise returns 'Undefined'
+
 private
 
    type Name_Information is record