VB24-035: Factorize code for hover and completion tooltips

And try to use GNATdoc to extract the documentation and format
the declarations when possible.

Add a proper exception handler when needed.

Author: AnthonyLeonardoGracio

source/ada/lsp-ada_contexts.adb

@@ -646,6 +646,7 @@ package body LSP.Ada_Contexts is
      (Self                : in out Context;
       File_Reader         : File_Reader_Interface'Class;
       Follow_Symlinks     : Boolean;
+      Style               : GNATdoc.Comments.Options.Documentation_Style;
       As_Fallback_Context : Boolean := False) is
    begin
       Self.Follow_Symlinks := Follow_Symlinks;
@@ -658,6 +659,8 @@ package body LSP.Ada_Contexts is
          With_Trivia   => True,
          Charset       => Self.Get_Charset,
          Tab_Stop      => 1);
+      Self.Style := Style;
+
       --  Tab stop is set 1 to disable "visible character guessing" by LAL.
       Self.Is_Fallback_Context := As_Fallback_Context;
    end Initialize;

source/ada/lsp-ada_contexts.ads

@@ -24,6 +24,8 @@ with GNATCOLL.Projects;
 with GNATCOLL.Traces;
 with GNATCOLL.VFS;
 
+with GNATdoc.Comments.Options;
+
 with Langkit_Support.File_Readers; use Langkit_Support.File_Readers;
 with Laltools.Common;
 
@@ -53,10 +55,13 @@ package LSP.Ada_Contexts is
      (Self                : in out Context;
       File_Reader         : File_Reader_Interface'Class;
       Follow_Symlinks     : Boolean;
+      Style               : GNATdoc.Comments.Options.Documentation_Style;
       As_Fallback_Context : Boolean := False);
    --  Initialize the context, set Follow_Symlinks flag.
    --  As_Fallback_Context should be set when we are creating the "fallback"
    --  context based on the empty project.
+   --  Style is used to extract the documentation of entities, for tooltips
+   --  in particular.
 
    procedure Load_Project
      (Self     : in out Context;
@@ -212,6 +217,10 @@ package LSP.Ada_Contexts is
      Utils.Command_Lines.Command_Line;
    --  Return the command line for the Pretty Printer
 
+   function Get_Documentation_Style (Self : Context) return
+     GNATdoc.Comments.Options.Documentation_Style;
+   --  Get the documentation style used for this context.
+
    function Analysis_Units
      (Self : Context) return Libadalang.Analysis.Analysis_Unit_Array;
    --  Return the analysis units for all Ada sources known to this context
@@ -348,6 +357,10 @@ private
                     (Pp.Command_Lines.Descriptor'Access);
       --  Object to keep gnatpp options
 
+      Style : GNATdoc.Comments.Options.Documentation_Style :=
+        GNATdoc.Comments.Options.GNAT;
+      --  The context's documentation style.
+
       Follow_Symlinks : Boolean := True;
       --  See LSP.Ada_Handlers for description
 
@@ -369,4 +382,7 @@ private
    function Get_PP_Options (Self : Context) return
      Utils.Command_Lines.Command_Line is (Self.PP_Options);
 
+   function Get_Documentation_Style (Self : Context) return
+     GNATdoc.Comments.Options.Documentation_Style is (Self.Style);
+
 end LSP.Ada_Contexts;

source/ada/lsp-ada_documents.adb

@@ -2513,28 +2513,39 @@ package body LSP.Ada_Documents is
       Item                    : in out LSP.Messages.CompletionItem;
       Compute_Doc_And_Details : Boolean)
    is
-      use LSP.Messages;
    begin
       --  Compute the 'documentation' and 'detail' fields immediately if
       --  requested (i.e: when the client does not support lazy computation
       --  for these fields or if we are dealing with predefined types).
       if Compute_Doc_And_Details or else LSP.Lal_Utils.Is_Synthetic (BD) then
-         Item.detail := (True, LSP.Lal_Utils.Compute_Completion_Detail (BD));
-
-         --  Property_Errors can occur when calling
-         --  Get_Documentation on unsupported docstrings, so
-         --  add an exception handler to catch them and recover.
+         declare
+            Loc_Text  : VSS.Strings.Virtual_String;
+            Doc_Text  : VSS.Strings.Virtual_String;
+            Decl_Text : VSS.Strings.Virtual_String;
          begin
+            LSP.Lal_Utils.Get_Tooltip_Text
+              (BD        => BD,
+               Trace     => Context.Trace,
+               Style     => Context.Get_Documentation_Style,
+               Loc_Text  => Loc_Text,
+               Doc_Text  => Doc_Text,
+               Decl_Text => Decl_Text);
+
+            Item.detail := (True, Decl_Text);
+
+            if not Doc_Text.Is_Empty then
+               Loc_Text.Append
+                 (VSS.Strings.To_Virtual_String
+                    ((1 .. 2 => Ada.Characters.Wide_Wide_Latin_1.LF)));
+
+               Loc_Text.Append (Doc_Text);
+            end if;
+
             Item.documentation :=
               (Is_Set => True,
-               Value  => String_Or_MarkupContent'
+               Value  => LSP.Messages.String_Or_MarkupContent'
                  (Is_String => True,
-                  String    => LSP.Lal_Utils.Compute_Completion_Doc (BD)));
-
-         exception
-            when E : Libadalang.Common.Property_Error =>
-               LSP.Common.Log (Context.Trace, E);
-               Item.documentation := (others => <>);
+                  String    => Loc_Text));
          end;
       else
          --  Set node's location to the 'data' field of the completion item, so

source/ada/lsp-ada_documents.ads

@@ -20,7 +20,6 @@
 with Ada.Containers.Ordered_Maps;
 with Ada.Containers.Vectors;
 with VSS.String_Vectors;
-
 with VSS.Strings;
 private with VSS.Strings.Markers;
 

source/ada/lsp-ada_handlers.adb

@@ -96,8 +96,6 @@ with Libadalang.Doc_Utils;
 with Libadalang.Helpers;
 with Libadalang.Preprocessing;
 
-with GNATdoc.Comments.Helpers;
-
 with URIs;
 
 package body LSP.Ada_Handlers is
@@ -669,8 +667,11 @@ package body LSP.Ada_Handlers is
       Self.Project_Environment.Set_Trusted_Mode (not Self.Follow_Symlinks);
       Self.Project_Tree := new Project_Tree;
 
-      C.Initialize (Reader, Self.Follow_Symlinks,
-                    As_Fallback_Context => True);
+      C.Initialize
+        (File_Reader         => Reader,
+         Follow_Symlinks     => Self.Follow_Symlinks,
+         Style               => Self.Options.Documentation.Style,
+         As_Fallback_Context => True);
 
       --  Note: we would call Load_Implicit_Project here, but this has
       --  two problems:
@@ -3101,9 +3102,7 @@ package body LSP.Ada_Handlers is
 
       Defining_Name_Node : Defining_Name;
       Decl               : Basic_Decl;
-      Decl_Lines         : VSS.String_Vectors.Virtual_String_Vector;
       Decl_Text          : VSS.Strings.Virtual_String;
-      Comments_Lines     : VSS.String_Vectors.Virtual_String_Vector;
       Comments_Text      : VSS.Strings.Virtual_String;
       Location_Text      : VSS.Strings.Virtual_String;
 
@@ -3112,12 +3111,6 @@ package body LSP.Ada_Handlers is
       --  For the Hover request, we're only interested in the "best"
       --  response value, not in the list of values for all contexts
 
-      Options : constant
-        GNATdoc.Comments.Options.Extractor_Options :=
-          (Style    => Self.Options.Documentation.Style,
-           Pattern  => <>,
-           Fallback => True);
-
    begin
       Self.Imprecise_Resolve_Name (C, Value, Defining_Name_Node);
 
@@ -3132,30 +3125,13 @@ package body LSP.Ada_Handlers is
          return Response;
       end if;
 
-      --  Extract documentation with GNATdoc when supported.
-
-      GNATdoc.Comments.Helpers.Get_Plain_Text_Documentation
-        (Defining_Name_Node, Options, Decl_Lines, Comments_Lines);
-
-      Decl_Text := Decl_Lines.Join_Lines (VSS.Strings.LF, False);
-      Comments_Text := Comments_Lines.Join_Lines (VSS.Strings.LF, False);
-
-      --  Obtain documentation when GNATdoc support is missing.
-
-      if Comments_Text.Is_Empty then
-         Comments_Text :=
-           VSS.Strings.To_Virtual_String
-             (Libadalang.Doc_Utils.Get_Documentation (Decl).Doc.To_String);
-      end if;
-
-      if Decl_Text.Is_Empty
-        or else not Decl.P_Subp_Spec_Or_Null.Is_Null
-      then
-         --  For subprograms additional information is added, use old code to
-         --  obtain it yet.
-
-         Decl_Text := Get_Hover_Text (Decl, Decl_Lines);
-      end if;
+      LSP.Lal_Utils.Get_Tooltip_Text
+        (BD        => Decl,
+         Trace     => Self.Trace,
+         Style     => C.Get_Documentation_Style,
+         Loc_Text  => Location_Text,
+         Doc_Text  => Comments_Text,
+         Decl_Text => Decl_Text);
 
       if Decl_Text.Is_Empty then
          return Response;
@@ -4666,10 +4642,13 @@ package body LSP.Ada_Handlers is
            Libadalang.Preprocessing.Create_Preprocessor_Data
              (Default_Config, File_Configs);
 
-         C.Initialize (Reader, Self.Follow_Symlinks);
+         C.Initialize
+           (Reader,
+            Style           => Self.Options.Documentation.Style,
+            Follow_Symlinks => Self.Follow_Symlinks);
 
          C.Load_Project
-           (Self.Project_Tree,
+           (Tree    => Self.Project_Tree,
             Root    => P,
             Charset => VSS.Strings.Conversions.To_UTF_8_String (Charset));
 
@@ -5555,25 +5534,35 @@ package body LSP.Ada_Handlers is
       --  Compute the completion item's details
       if not Node.Is_Null then
          declare
-            BD : constant Libadalang.Analysis.Basic_Decl :=
+            BD        : constant Libadalang.Analysis.Basic_Decl :=
               Node.As_Basic_Decl;
+            Loc_Text  : VSS.Strings.Virtual_String;
+            Doc_Text  : VSS.Strings.Virtual_String;
+            Decl_Text : VSS.Strings.Virtual_String;
          begin
-            Item.detail := (True, Compute_Completion_Detail (BD));
-
-            --  Property_Errors can occur when calling
-            --  Get_Documentation on unsupported docstrings, so
-            --  add an exception handler to catch them and recover.
+            LSP.Lal_Utils.Get_Tooltip_Text
+              (BD          => BD,
+               Trace       => C.Trace,
+               Style       => Self.Options.Documentation.Style,
+               Loc_Text    => Loc_Text,
+               Doc_Text    => Doc_Text,
+               Decl_Text => Decl_Text);
+
+            Item.detail := (True, Decl_Text);
+
+            if not Doc_Text.Is_Empty then
+               Loc_Text.Append
+                 (VSS.Strings.To_Virtual_String
+                    ((1 .. 2 => Ada.Characters.Wide_Wide_Latin_1.LF)));
+
+               Loc_Text.Append (Doc_Text);
+            end if;
 
             Item.documentation :=
               (Is_Set => True,
                Value  => LSP.Messages.String_Or_MarkupContent'
                  (Is_String => True,
-                  String    => LSP.Lal_Utils.Compute_Completion_Doc (BD)));
-
-         exception
-            when E : Libadalang.Common.Property_Error =>
-               LSP.Common.Log (C.Trace, E);
-               Item.documentation := (others => <>);
+                  String    => Loc_Text));
          end;
 
          Response.result := Item;