Add a trivial textDocument/selectionRange request handler

reznikmm · reznikmm · commit 4fc0beb62cb7 · 2024-12-27T15:29:55.000Z
Refs #1574
diff --git a/liblsp_3_17/source/lsp-constants.ads b/liblsp_3_17/source/lsp-constants.ads
@@ -131,6 +131,10 @@ package LSP.Constants is
      return LSP.Structures.Boolean_Or_DocumentRangeFormattingOptions_Optional
       is (Is_Set => True, Value => (Is_Boolean => True, Boolean => True));
 
+   function True
+     return LSP.Structures.selectionRangeProvider_OfServerCapabilities_Optional
+      is (Is_Set => True, Value => (LSP.Structures.Variant_1, True));
+
    function Empty return LSP.Structures.Position
       is (line => 0, character => 0);
 
diff --git a/source/ada/lsp-ada_client_capabilities.adb b/source/ada/lsp-ada_client_capabilities.adb
@@ -422,6 +422,7 @@ package body LSP.Ada_Client_Capabilities is
          Result.hoverProvider                   := LSP.Constants.True;
          Result.implementationProvider          := LSP.Constants.True;
          Result.referencesProvider              := LSP.Constants.True;
+         Result.selectionRangeProvider          := LSP.Constants.True;
          Result.typeDefinitionProvider          := LSP.Constants.True;
          Result.typeHierarchyProvider           := LSP.Constants.True;
          Result.workspaceSymbolProvider         := LSP.Constants.True;
diff --git a/source/ada/lsp-ada_driver.adb b/source/ada/lsp-ada_driver.adb
@@ -78,6 +78,7 @@ with LSP.Ada_Handlers.Refactor.Suppress_Seperate;
 with LSP.Ada_Handlers.Show_Dependencies_Commands;
 with LSP.Ada_Handlers.Source_Dirs_Commands;
 with LSP.Ada_Handlers.Suspend_Executions;
+with LSP.Ada_Selection_Range;
 with LSP.Ada_Tokens_Full;
 with LSP.Ada_Tokens_Range;
 with LSP.Ada_Type_Hierarchy_Subtypes;
@@ -111,6 +112,7 @@ with LSP.Server_Requests.Hover;
 with LSP.Server_Requests.Initialize;
 with LSP.Server_Requests.PrepareTypeHierarchy;
 with LSP.Server_Requests.References;
+with LSP.Server_Requests.SelectionRange;
 with LSP.Server_Requests.Subtypes;
 with LSP.Server_Requests.Supertypes;
 with LSP.Server_Requests.Tokens_Full;
@@ -299,6 +301,10 @@ procedure LSP.Ada_Driver is
      LSP.Ada_Folding_Range.Ada_Folding_Range_Handler
        (Ada_Handler'Unchecked_Access);
 
+   Ada_Selection_Range_Handler : aliased
+     LSP.Ada_Selection_Range.Ada_Selection_Range_Handler
+       (Ada_Handler'Unchecked_Access);
+
    Ada_Tokens_Full_Handler : aliased
      LSP.Ada_Tokens_Full.Ada_Tokens_Full_Handler
        (Ada_Handler'Unchecked_Access);
@@ -681,6 +687,10 @@ begin
            (LSP.Server_Requests.FoldingRange.Request'Tag,
             Ada_Folding_Range_Handler'Unchecked_Access);
 
+         Server.Register_Handler
+           (LSP.Server_Requests.SelectionRange.Request'Tag,
+            Ada_Selection_Range_Handler'Unchecked_Access);
+
          Server.Register_Handler
            (LSP.Server_Requests.Tokens_Full.Request'Tag,
             Ada_Tokens_Full_Handler'Unchecked_Access);
diff --git a/source/ada/lsp-ada_handlers-locations.adb b/source/ada/lsp-ada_handlers-locations.adb
@@ -321,6 +321,37 @@ package body LSP.Ada_Handlers.Locations is
       return To_LSP_Range (Unit, Sloc);
    end To_LSP_Range;
 
+   ------------------
+   -- To_LSP_Range --
+   ------------------
+
+   function To_LSP_Range
+     (Self : in out Message_Handler'Class;
+      Node : Libadalang.Analysis.Ada_Node'Class)
+      return LSP.Structures.A_Range
+   is
+      use type LSP.Ada_Documents.Document_Access;
+
+      URI : constant LSP.Structures.DocumentUri :=
+        (VSS.Strings.Conversions.To_Virtual_String
+           (URIs.Conversions.From_File (Node.Unit.Get_Filename))
+         with null record);
+
+      Sloc : constant Langkit_Support.Slocs.Source_Location_Range :=
+        Node.Sloc_Range;
+
+      Doc : constant LSP.Ada_Documents.Document_Access :=
+        Self.Get_Open_Document (URI);
+
+   begin
+      if Doc /= null then
+         return Doc.To_A_Range (Sloc);
+
+      else
+         return To_LSP_Range (Node.Unit, Sloc);
+      end if;
+   end To_LSP_Range;
+
    ---------------------
    -- To_LSP_Location --
    ---------------------
diff --git a/source/ada/lsp-ada_handlers-locations.ads b/source/ada/lsp-ada_handlers-locations.ads
@@ -51,6 +51,11 @@ package LSP.Ada_Handlers.Locations is
       Token : Libadalang.Common.Token_Reference)
       return LSP.Structures.A_Range;
 
+   function To_LSP_Range
+     (Self  : in out Message_Handler'Class;
+      Node : Libadalang.Analysis.Ada_Node'Class)
+      return LSP.Structures.A_Range;
+
    function Get_Node_At
      (Self     : in out Message_Handler'Class;
       Context  : LSP.Ada_Contexts.Context;
diff --git a/source/ada/lsp-ada_handlers.adb b/source/ada/lsp-ada_handlers.adb
@@ -148,6 +148,12 @@ package body LSP.Ada_Handlers is
       return LSP.Structures.Location is
         (LSP.Ada_Handlers.Locations.To_LSP_Location (Self, Node));
 
+   overriding function To_LSP_Range
+     (Self  : in out Message_Handler;
+      Node   : Libadalang.Analysis.Ada_Node'Class)
+      return LSP.Structures.A_Range is
+        (LSP.Ada_Handlers.Locations.To_LSP_Range (Self, Node));
+
    overriding function To_LSP_Range
      (Self  : in out Message_Handler;
       Unit  : Libadalang.Analysis.Analysis_Unit;
diff --git a/source/ada/lsp-ada_handlers.ads b/source/ada/lsp-ada_handlers.ads
@@ -509,6 +509,11 @@ private
       Token : Libadalang.Common.Token_Reference)
       return LSP.Structures.A_Range;
 
+   overriding function To_LSP_Range
+     (Self  : in out Message_Handler;
+      Node   : Libadalang.Analysis.Ada_Node'Class)
+      return LSP.Structures.A_Range;
+
    overriding procedure Append_Location
      (Self   : in out Message_Handler;
       Result : in out LSP.Structures.Location_Vector;
diff --git a/source/ada/lsp-ada_job_contexts.ads b/source/ada/lsp-ada_job_contexts.ads
@@ -132,6 +132,11 @@ package LSP.Ada_Job_Contexts is
       Node   : Libadalang.Analysis.Ada_Node'Class)
       return LSP.Structures.Location is abstract;
 
+   function To_LSP_Range
+     (Self   : in out Ada_Job_Context;
+      Node   : Libadalang.Analysis.Ada_Node'Class)
+      return LSP.Structures.A_Range is abstract;
+
    function To_LSP_Range
      (Self  : in out Ada_Job_Context;
       Unit  : Libadalang.Analysis.Analysis_Unit;
diff --git a/source/ada/lsp-ada_selection_range.adb b/source/ada/lsp-ada_selection_range.adb
@@ -0,0 +1,139 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                        Copyright (C) 2024, AdaCore                       --
+--                                                                          --
+-- This is free software;  you can redistribute it  and/or modify it  under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  This software is distributed in the hope  that it will be useful, --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+with Libadalang;
+with Libadalang.Analysis;
+with LSP.Ada_Context_Sets;
+with LSP.Ada_Request_Jobs;
+with LSP.Client_Message_Receivers;
+with LSP.Server_Requests.SelectionRange;
+with LSP.Structures;
+
+package body LSP.Ada_Selection_Range is
+
+   type Ada_Selection_Range_Job
+     (Parent : not null access constant Ada_Selection_Range_Handler) is limited
+   new LSP.Ada_Request_Jobs.Ada_Request_Job
+     (Priority => LSP.Server_Jobs.High)
+        with null record;
+
+   overriding procedure Execute_Ada_Request
+     (Self   : in out Ada_Selection_Range_Job;
+      Client :
+        in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
+      Status : out LSP.Server_Jobs.Execution_Status);
+
+   type Ada_Selection_Range_Job_Access is access all Ada_Selection_Range_Job;
+
+   function Process
+     (Self : Ada_Selection_Range_Handler'Class;
+      Node : Libadalang.Analysis.Ada_Node)
+        return LSP.Structures.SelectionRange;
+
+   ----------------
+   -- Create_Job --
+   ----------------
+
+   overriding function Create_Job
+     (Self    : Ada_Selection_Range_Handler;
+      Message : LSP.Server_Messages.Server_Message_Access)
+        return LSP.Server_Jobs.Server_Job_Access
+   is
+      Result : constant Ada_Selection_Range_Job_Access :=
+        new Ada_Selection_Range_Job'
+          (Parent  => Self'Unchecked_Access,
+           Request => LSP.Ada_Request_Jobs.Request_Access (Message));
+   begin
+      return LSP.Server_Jobs.Server_Job_Access (Result);
+   end Create_Job;
+
+   -------------------------
+   -- Execute_Ada_Request --
+   -------------------------
+
+   overriding procedure Execute_Ada_Request
+     (Self   : in out Ada_Selection_Range_Job;
+      Client :
+        in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
+      Status : out LSP.Server_Jobs.Execution_Status)
+   is
+      Message : LSP.Server_Requests.SelectionRange.Request
+        renames LSP.Server_Requests.SelectionRange.Request (Self.Message.all);
+
+      Value : LSP.Structures.SelectionRangeParams renames Message.Params;
+
+      Response : LSP.Structures.SelectionRange_Vector_Or_Null;
+
+      Context : constant LSP.Ada_Context_Sets.Context_Access :=
+        Self.Parent.Context.Get_Best_Context
+          (Value.textDocument.uri);
+
+   begin
+      Status := LSP.Server_Jobs.Done;
+
+      for Item of Value.positions loop
+         declare
+            Pos : constant LSP.Structures.TextDocumentPositionParams :=
+              (Value.textDocument, Item);
+            Node : constant Libadalang.Analysis.Ada_Node :=
+              Self.Parent.Context.Get_Node_At (Context.all, Pos);
+         begin
+            Response.Append (Self.Parent.Process (Node));
+         end;
+      end loop;
+
+      Client.On_SelectionRange_Response (Message.Id, Response);
+   end Execute_Ada_Request;
+
+   -------------
+   -- Process --
+   -------------
+
+   function Process
+     (Self : Ada_Selection_Range_Handler'Class;
+      Node : Libadalang.Analysis.Ada_Node)
+        return LSP.Structures.SelectionRange
+   is
+      Result : LSP.Structures.SelectionRange;
+      First  : Boolean := True;
+      List   : constant Libadalang.Analysis.Ada_Node_Array :=
+        (if Node.Is_Null then [] else Node.Parents);
+   begin
+      for Item of reverse List loop
+         declare
+            Next : LSP.Structures.SelectionRange;
+         begin
+            Next.a_range := Self.Context.To_LSP_Range (Item);
+
+            if First then
+               First := False;
+            else
+               Next.parent.Set (Result);
+            end if;
+
+            Result := Next;
+         end;
+      end loop;
+
+      if First then
+         Result.a_range := ((0, 0), (0, 0));
+      end if;
+
+      return Result;
+   end Process;
+
+end LSP.Ada_Selection_Range;
diff --git a/source/ada/lsp-ada_selection_range.ads b/source/ada/lsp-ada_selection_range.ads
@@ -0,0 +1,38 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                        Copyright (C) 2024, AdaCore                       --
+--                                                                          --
+-- This is free software;  you can redistribute it  and/or modify it  under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  This software is distributed in the hope  that it will be useful, --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides handler and a job for textDocument/selectionRange
+--  requests.
+
+with LSP.Ada_Job_Contexts;
+with LSP.Server_Jobs;
+with LSP.Server_Message_Handlers;
+with LSP.Server_Messages;
+
+package LSP.Ada_Selection_Range is
+
+   type Ada_Selection_Range_Handler
+     (Context : not null access LSP.Ada_Job_Contexts.Ada_Job_Context'Class) is
+       limited new LSP.Server_Message_Handlers.Server_Message_Handler
+         with null record;
+
+   overriding function Create_Job
+     (Self    : Ada_Selection_Range_Handler;
+      Message : LSP.Server_Messages.Server_Message_Access)
+        return LSP.Server_Jobs.Server_Job_Access;
+
+end LSP.Ada_Selection_Range;
