T723-027: Implement SignatureHelp

Use P_All_Env_Elements and filter the returned node
to find all the function declaration with the same name.
Fix param type in the generated spec.

Add tests.

Author: AdrienBoulanger

scripts/generate.py

@@ -283,7 +283,7 @@
     ('textDocument/references', 'References', 'ReferenceParams',
      'Location_Response'),
     ('textDocument/signatureHelp', 'Signature_Help',
-     'TextDocumentPositionParams', 'SignatureHelp_Response'),
+     'SignatureHelpParams', 'SignatureHelp_Response'),
     ('textDocument/documentSymbol', 'Document_Symbols',
      'DocumentSymbolParams', 'Symbol_Response'),
     ('textDocument/rename', 'Rename', 'RenameParams', 'Rename_Response'),

source/ada/lsp-ada_contexts.adb

@@ -471,6 +471,30 @@ package body LSP.Ada_Contexts is
          Log (Self.Trace, E, "in Is_Called_By");
    end Find_All_Calls;
 
+   ---------------------------
+   -- Find_All_Env_Elements --
+   ---------------------------
+
+   function Find_All_Env_Elements
+     (Self     : Context;
+      Name     : Libadalang.Analysis.Name;
+      Seq      : Boolean := True;
+      Seq_From : Libadalang.Analysis.Ada_Node'Class :=
+        Libadalang.Analysis.No_Ada_Node)
+     return Libadalang.Analysis.Ada_Node_Array is
+   begin
+      return Libadalang.Analysis.P_All_Env_Elements (Name, Seq, Seq_From);
+   exception
+      when E : Libadalang.Common.Property_Error =>
+         Log (Self.Trace, E, "in Find_All_Env_Elements");
+         declare
+            Empty_Node_Array : constant
+              Libadalang.Analysis.Ada_Node_Array (1 .. 0) := (others => <>);
+         begin
+            return Empty_Node_Array;
+         end;
+   end Find_All_Env_Elements;
+
    -------------------------------
    -- Get_Any_Symbol_Completion --
    -------------------------------

source/ada/lsp-ada_contexts.ads

@@ -142,6 +142,17 @@ package LSP.Ada_Contexts is
    --  Return all the enclosing entities that call Definition in all sources
    --  known to this project.
 
+   function Find_All_Env_Elements
+     (Self     : Context;
+      Name     : Libadalang.Analysis.Name;
+      Seq      : Boolean := True;
+      Seq_From : Libadalang.Analysis.Ada_Node'Class :=
+        Libadalang.Analysis.No_Ada_Node)
+      return Libadalang.Analysis.Ada_Node_Array;
+   --  Return all elements lexically named like Name.
+   --  If Seq is True and Seq_From is not empty, reduce the scope to the
+   --  node above Seq_From.
+
    procedure Get_References_For_Renaming
      (Self              : Context;
       Definition        : Libadalang.Analysis.Defining_Name;

source/ada/lsp-ada_handlers.adb

@@ -690,6 +690,11 @@ package body LSP.Ada_Handlers is
                LSP.Messages.Incremental
             else
                LSP.Messages.Full));
+      Response.result.capabilities.signatureHelpProvider :=
+        (True,
+         (triggerCharacters   => (True, Empty_Vector & (+",") & (+"(")),
+          retriggerCharacters => (True, Empty_Vector & (+" ")),
+          workDoneProgress    => LSP.Types.None));
       Response.result.capabilities.completionProvider :=
         (True,
          (resolveProvider     => LSP.Types.False,
@@ -2788,15 +2793,91 @@ package body LSP.Ada_Handlers is
       Request : LSP.Messages.Server_Requests.Signature_Help_Request)
       return LSP.Messages.Server_Responses.SignatureHelp_Response
    is
-      pragma Unreferenced (Self, Request);
+      use Libadalang.Analysis;
+      use LSP.Messages;
+
+      Value   : LSP.Messages.SignatureHelpParams renames
+        Request.params;
       Response : LSP.Messages.Server_Responses.SignatureHelp_Response
-        (Is_Error => True);
+        (Is_Error => False);
+
+      C : constant Context_Access :=
+        Self.Contexts.Get_Best_Context (Value.textDocument.uri);
+
+      Node : constant Libadalang.Analysis.Ada_Node :=
+        C.Get_Node_At
+          (Get_Open_Document (Self, Value.textDocument.uri),
+           Value);
+      Name_Node       : Libadalang.Analysis.Name;
+      Designator      : Libadalang.Analysis.Ada_Node;
+      Active_Position : LSP.Types.LSP_Number;
+
+      procedure Add_Signature (Decl_Node : Libadalang.Analysis.Basic_Decl);
+
+      -------------------
+      -- Add_Signature --
+      -------------------
+
+      procedure Add_Signature (Decl_Node : Libadalang.Analysis.Basic_Decl)
+      is
+         Param_Index : constant LSP.Types.LSP_Number :=
+           Get_Active_Parameter (Decl_Node, Designator, Active_Position);
+      begin
+         if Param_Index = -1 then
+            return;
+         end if;
+
+         declare
+            Signature : LSP.Messages.SignatureInformation :=
+              (label          => Get_Hover_Text (Decl_Node),
+               documentation  =>
+                 (Is_Set => True,
+                  Value  =>
+                    (Is_String => True,
+                     String    =>
+                       To_LSP_String
+                         (Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Encode
+                              (Libadalang.Doc_Utils.Get_Documentation
+                                 (Decl_Node).Doc.To_String)
+                         )
+                    )
+                 ),
+               activeParameter =>
+                 (Is_Set => True,
+                  Value  => Param_Index
+                 ),
+               others          => <>
+              );
+         begin
+            Get_Parameters (Decl_Node, Signature.parameters);
+            Response.result.signatures.Append (Signature);
+         end;
+      end Add_Signature;
+
    begin
-      Response.error :=
-        (True,
-         (code => LSP.Errors.InternalError,
-          message => +"Not implemented",
-          data => <>));
+      Response.result := (others => <>);
+
+      --  Check if we are inside a function call and get the caller name
+      Get_Call_Expr_Name (Node, Active_Position, Designator, Name_Node);
+
+      if Name_Node = Libadalang.Analysis.No_Name then
+         return Response;
+      end if;
+
+      for N of C.Find_All_Env_Elements (Name_Node) loop
+         if N.Kind in Ada_Subp_Decl_Range then
+            Add_Signature (N.As_Basic_Decl);
+         end if;
+      end loop;
+
+      --  Set the active values to default
+      Response.result.activeSignature := (Is_Set => True,
+                                          Value  => 0);
+      --  activeParameter will be ignored because it is properly set in
+      --  the signatures.
+      Response.result.activeParameter := (Is_Set => True,
+                                          Value  => 0);
+
       return Response;
    end On_Signature_Help_Request;
 

source/ada/lsp-lal_utils.adb

@@ -350,6 +350,140 @@ package body LSP.Lal_Utils is
       return LSP.Messages.A_Null;
    end Get_Decl_Kind;
 
+   ------------------------
+   -- Get_Call_Expr_Name --
+   ------------------------
+
+   procedure Get_Call_Expr_Name
+     (Node            : Libadalang.Analysis.Ada_Node'Class;
+      Active_Position : out LSP.Types.LSP_Number;
+      Designator      : out Libadalang.Analysis.Ada_Node;
+      Name_Node       : out Libadalang.Analysis.Name)
+   is
+      Cur_Node : Ada_Node := Node.As_Ada_Node;
+   begin
+      Active_Position := 0;
+      Name_Node := Libadalang.Analysis.No_Name;
+
+      --  Find the first Call_Expr node in the parents
+      while not Cur_Node.Is_Null loop
+         exit when Cur_Node.Kind in Ada_Call_Expr_Range;
+
+         Cur_Node := Cur_Node.Parent;
+      end loop;
+
+      if Cur_Node.Is_Null then
+         return;
+      end if;
+
+      declare
+         Call_Expr_Node  : constant Libadalang.Analysis.Call_Expr :=
+           Cur_Node.As_Call_Expr;
+         Suffix_Node     : constant Libadalang.Analysis.Ada_Node'Class :=
+           Call_Expr_Node.F_Suffix;
+         Node_Parents    : constant Libadalang.Analysis.Ada_Node_Array :=
+           Node.Parents;
+      begin
+         Name_Node := Call_Expr_Node.F_Name;
+
+         if Suffix_Node = Libadalang.Analysis.No_Ada_Node then
+            return;
+         end if;
+
+         --  Find the position in the Assoc_List
+         if Suffix_Node.Kind in Ada_Assoc_List_Range then
+            for Assoc of Suffix_Node.As_Assoc_List loop
+               Designator := Assoc.As_Param_Assoc.F_Designator;
+               for Parent of Node_Parents loop
+                  exit when Assoc = Parent;
+               end loop;
+               Active_Position := Active_Position + 1;
+            end loop;
+         end if;
+         --  The active position index starts at 0
+         Active_Position := Active_Position - 1;
+      end;
+   end Get_Call_Expr_Name;
+
+   --------------------
+   -- Get_Parameters --
+   --------------------
+
+   procedure Get_Parameters
+     (Node : Libadalang.Analysis.Basic_Decl;
+      Parameters : in out LSP.Messages.ParameterInformation_Vector)
+   is
+      Spec : constant Libadalang.Analysis.Base_Subp_Spec :=
+        Node.P_Subp_Spec_Or_Null;
+   begin
+      if Spec = Libadalang.Analysis.No_Base_Subp_Spec then
+         return;
+      end if;
+
+      for Param of Spec.P_Params loop
+         for Id of Param.F_Ids loop
+            declare
+               P : constant LSP.Messages.ParameterInformation :=
+                 (label         =>
+                    (Is_String => True,
+                     String    => To_LSP_String (Id.Text)),
+                  documentation =>
+                    (Is_Set => False)
+                 );
+            begin
+               Parameters.Append (P);
+            end;
+         end loop;
+      end loop;
+   end Get_Parameters;
+
+   --------------------------
+   -- Get_Active_Parameter --
+   --------------------------
+
+   function Get_Active_Parameter
+     (Node       : Libadalang.Analysis.Basic_Decl;
+      Designator : Libadalang.Analysis.Ada_Node;
+      Position   : LSP.Types.LSP_Number)
+      return LSP.Types.LSP_Number
+   is
+      Spec : constant Libadalang.Analysis.Base_Subp_Spec :=
+        Node.P_Subp_Spec_Or_Null;
+      Index : LSP.Types.LSP_Number := 0;
+   begin
+      if Spec = Libadalang.Analysis.No_Base_Subp_Spec then
+         return -1;
+
+      elsif Designator = Libadalang.Analysis.No_Ada_Node then
+         --  Check if the given position is a valid index for Node
+         for Param of Spec.P_Params loop
+            for Id of Param.F_Ids loop
+               Index := Index + 1;
+            end loop;
+         end loop;
+         if Position > Index - 1 then
+            return -1;
+         else
+            return Position;
+         end if;
+
+      else
+         --  If we have a designator then try to find the position of a
+         --  parameter with the same name
+         for Param of Spec.P_Params loop
+            for Id of Param.F_Ids loop
+               if Id.Text = Designator.Text then
+                  return Index;
+               end if;
+               Index := Index + 1;
+            end loop;
+         end loop;
+
+         --  No matching designator
+         return -1;
+      end if;
+   end Get_Active_Parameter;
+
    -----------------------
    -- Get_Node_Location --
    -----------------------

source/ada/lsp-lal_utils.ads

@@ -133,6 +133,29 @@ package LSP.Lal_Utils is
    --  When Ignore_Local it will return Is_Null for all local objects like
    --  variables.
 
+   procedure Get_Call_Expr_Name
+     (Node            : Libadalang.Analysis.Ada_Node'Class;
+      Active_Position : out LSP.Types.LSP_Number;
+      Designator      : out Libadalang.Analysis.Ada_Node;
+      Name_Node       : out Libadalang.Analysis.Name);
+   --  If Node is inside a Call_Expr returns the following:
+   --  Active_Position: the index of the parameter in the Call_Expr
+   --  Designator: the designator of the Active_Position
+   --  Name_Node: the name of the Call_Expr
+
+   procedure Get_Parameters
+     (Node : Libadalang.Analysis.Basic_Decl;
+      Parameters : in out LSP.Messages.ParameterInformation_Vector);
+   --  Append all the parameters of Node inside Parameters
+
+   function Get_Active_Parameter
+     (Node       : Libadalang.Analysis.Basic_Decl;
+      Designator : Libadalang.Analysis.Ada_Node;
+      Position   : LSP.Types.LSP_Number)
+      return LSP.Types.LSP_Number;
+   --  Return the position of Designator in the parameters of Node else -1
+   --  If Designator is null try check if Position is a valid parameter index
+
    function To_Call_Hierarchy_Item
      (Name : Libadalang.Analysis.Defining_Name)
       return LSP.Messages.CallHierarchyItem;

source/client/lsp-clients.adb

@@ -1167,7 +1167,7 @@ package body LSP.Clients is
    procedure Text_Document_Signature_Help_Request
      (Self    : in out Client'Class;
       Request : out LSP.Types.LSP_Number_Or_String;
-      Value   : LSP.Messages.TextDocumentPositionParams)
+      Value   : LSP.Messages.SignatureHelpParams)
    is
       Message : Signature_Help_Request := (params => Value, others => <>);
    begin

source/client/lsp-clients.ads

@@ -149,7 +149,7 @@ package LSP.Clients is
    procedure Text_Document_Signature_Help_Request
      (Self     : in out Client'Class;
       Request  : out LSP.Types.LSP_Number_Or_String;
-      Value    : LSP.Messages.TextDocumentPositionParams);
+      Value    : LSP.Messages.SignatureHelpParams);
 
    procedure Text_Document_Symbol_Request
      (Self     : in out Client'Class;

source/protocol/generated/lsp-messages-server_requests.ads

@@ -179,7 +179,7 @@ package LSP.Messages.Server_Requests is
    package Signature_Help_Requests is
      new LSP.Generic_Requests
        (Server_Request,
-        TextDocumentPositionParams,
+        SignatureHelpParams,
         Server_Request_Receiver'Class);
 
    type Signature_Help_Request is

testsuite/ada_lsp/T723-027.signatureHelp.nested/default.gpr

@@ -0,0 +1,3 @@
+project Default is
+
+end Default;