diff --git a/source/ada/lsp-ada_completions-generic_assoc.adb b/source/ada/lsp-ada_completions-generic_assoc.adb index 681ebc8ba..aaf63f197 100644 --- a/source/ada/lsp-ada_completions-generic_assoc.adb +++ b/source/ada/lsp-ada_completions-generic_assoc.adb @@ -405,13 +405,12 @@ package body LSP.Ada_Completions.Generic_Assoc is end if; Prefix_Span := - Self.Document.To_LSP_Range + Self.Document.To_A_Range (Langkit_Support.Slocs.Make_Range (Langkit_Support.Slocs.Start_Sloc (Get_Prefix_Node (Elem_Node, Column => Column).Sloc_Range), Sloc)); - Prefix := Self.Document.Get_Text_At - (Prefix_Span.start, Prefix_Span.an_end); + Prefix := Self.Document.Slice (Prefix_Span); Parameters := Get_Parameters (Elem_Node, Prefixed); Using_Name := Has_Designator (Unnamed_Params); diff --git a/source/ada/lsp-ada_documents-lal_diagnostics.adb b/source/ada/lsp-ada_documents-lal_diagnostics.adb index ac44a35ac..b91c4d245 100644 --- a/source/ada/lsp-ada_documents-lal_diagnostics.adb +++ b/source/ada/lsp-ada_documents-lal_diagnostics.adb @@ -40,11 +40,12 @@ package body LSP.Ada_Documents.LAL_Diagnostics is Self.Errors := Self.Get_Diagnostics (Context); for J in Self.Errors.List'Range loop - Item.a_range := Self.Document.To_LSP_Range - (Self.Errors.List (J).Sloc_Range); + Item.a_range := + Self.Document.To_A_Range (Self.Errors.List (J).Sloc_Range); - Item.message := VSS.Strings.Conversions.To_Virtual_String - (Self.Errors.List (J).Message); + Item.message := + VSS.Strings.Conversions.To_Virtual_String + (Self.Errors.List (J).Message); Errors.Append (Item); end loop; diff --git a/source/ada/lsp-ada_documents.adb b/source/ada/lsp-ada_documents.adb index c12515925..fffa3a305 100644 --- a/source/ada/lsp-ada_documents.adb +++ b/source/ada/lsp-ada_documents.adb @@ -16,7 +16,6 @@ ------------------------------------------------------------------------------ with Ada.Tags; -with Ada.Unchecked_Deallocation; with GNAT.Strings; with GNATCOLL.Traces; @@ -35,12 +34,9 @@ with Libadalang.Sources; with VSS.Characters.Latin; with VSS.Strings.Character_Iterators; with VSS.Strings.Conversions; -with VSS.Strings.Cursors; with VSS.Strings.Formatters.Integers; with VSS.Strings.Formatters.Strings; -with VSS.Strings.Line_Iterators; with VSS.Strings.Templates; -with VSS.Unicode; with LSP.Ada_Completions.Filters; with LSP.Ada_Contexts; @@ -65,25 +61,6 @@ package body LSP.Ada_Documents is ("ALS.LAL_PP_OUTPUT_ON_FORMATTING", GNATCOLL.Traces.Off); -- Logging lalpp output if On - procedure Recompute_Indexes (Self : in out Document'Class); - -- Recompute the line-to-offset indexes in Self - - procedure Recompute_Markers - (Self : in out Document'Class; - Low_Line : Natural; - Start_Marker : VSS.Strings.Markers.Character_Marker; - End_Marker : VSS.Strings.Markers.Character_Marker); - -- Recompute line-to-marker index starting from Start_Marker till - -- End_Marker and filling index table starting at Low_Line. End_Marker - -- may be invalid marker, in this case indexing down to the end of the - -- text. - - procedure Span_To_Markers - (Self : Document'Class; - Span : LSP.Structures.A_Range; - From : out VSS.Strings.Markers.Character_Marker; - To : out VSS.Strings.Markers.Character_Marker); - function To_Completion_Kind (K : LSP.Enumerations.SymbolKind) return LSP.Enumerations.CompletionItemKind is @@ -104,100 +81,6 @@ package body LSP.Ada_Documents is -- TODO: It might be better to have a unified kind, and then convert to -- specific kind types, but for the moment this is good enough. - ------------------- - -- Apply_Changes -- - ------------------- - - procedure Apply_Changes - (Self : aliased in out Document; - Version : Integer; - Vector : LSP.Structures.TextDocumentContentChangeEvent_Vector) - is - Dummy : Libadalang.Analysis.Analysis_Unit; - begin - Self.Version := Version; - - for Change of Vector loop - if Change.a_range.Is_Set then - -- We're replacing a range - - declare - Low_Line : Natural := Change.a_range.Value.start.line; - High_Line : Natural := Change.a_range.Value.an_end.line; - Delete_High : Natural := High_Line; - Start_Index : Natural; - - First_Marker : VSS.Strings.Markers.Character_Marker; - Last_Marker : VSS.Strings.Markers.Character_Marker; - Start_Marker : VSS.Strings.Markers.Character_Marker; - End_Marker : VSS.Strings.Markers.Character_Marker; - - begin - -- Do text replacement - - Self.Span_To_Markers - (Change.a_range.Value, First_Marker, Last_Marker); - Self.Text.Replace (First_Marker, Last_Marker, Change.text); - - -- Markers inside modified range of lines need to be - -- recomputed, markers outside of this range has been - -- recomputed by call to Replace. - - -- Use marker of the line before the first modified line as - -- start marker for recompute because marker of the first - -- modified line may be ether invalidated or moved by Replace, - -- or start from first character of the new text when first - -- line was modified. - - if Low_Line /= Self.Line_To_Marker.First_Index then - Low_Line := Low_Line - 1; - Start_Index := Low_Line; - Start_Marker := Self.Line_To_Marker (Low_Line); - - else - Start_Index := Self.Line_To_Marker.First_Index; - Start_Marker := Self.Text.At_First_Character.Marker; - end if; - - -- Use marker of the line after the last modified line as end - -- marker for recompute because marker of the last modified - -- line may be ether invalidated or moved and not point to the - -- beginning of the line, or use invalid marker when last line - -- was modified. - - if High_Line /= Self.Line_To_Marker.Last_Index then - Delete_High := High_Line; - High_Line := High_Line + 1; - End_Marker := Self.Line_To_Marker (High_Line); - end if; - - if Low_Line = Self.Line_To_Marker.First_Index - and then High_Line = Self.Line_To_Marker.Last_Index - then - Self.Recompute_Indexes; - - else - if Delete_High >= Low_Line then - Self.Line_To_Marker.Delete - (Low_Line, - Ada.Containers.Count_Type - (Delete_High - Low_Line + 1)); - end if; - - Self.Recompute_Markers - (Start_Index, Start_Marker, End_Marker); - end if; - end; - - else - Self.Text := Change.text; - - -- We're setting the whole text: compute the indexes now. - Self.Recompute_Indexes; - end if; - end loop; - end Apply_Changes; - ------------- -- Cleanup -- ------------- @@ -416,597 +299,6 @@ package body LSP.Ada_Documents is return Item; end Compute_Completion_Item; - ---------- - -- Diff -- - ---------- - - procedure Diff - (Self : Document; - New_Text : VSS.Strings.Virtual_String; - Old_Span : LSP.Structures.A_Range := Empty_Range; - New_Span : LSP.Structures.A_Range := Empty_Range; - Edit : out LSP.Structures.TextEdit_Vector) - is - use type LSP.Structures.A_Range; - use type LSP.Structures.Position; - - Old_First_Line : Natural; - New_First_Line : Natural; - - Old_Lines, New_Lines : VSS.String_Vectors.Virtual_String_Vector; - Old_Length, New_Length : Natural; - - begin - Old_Lines := - Self.Text.Split_Lines - (Terminators => LSP_New_Line_Function_Set, - Keep_Terminator => True); - New_Lines := - New_Text.Split_Lines - (Terminators => LSP_New_Line_Function_Set, - Keep_Terminator => True); - - if Old_Span = Empty_Range then - Old_First_Line := 1; - Old_Length := Old_Lines.Length; - - else - Old_First_Line := Natural (Old_Span.start.line + 1); - Old_Length := - Natural (Old_Span.an_end.line - Old_Span.start.line + 1); - end if; - - if New_Span = Empty_Range then - New_First_Line := 1; - New_Length := New_Lines.Length; - else - New_First_Line := Natural (New_Span.start.line + 1); - New_Length := - Natural (New_Span.an_end.line - New_Span.start.line + 1); - end if; - - declare - use type VSS.Strings.Virtual_String; - - type LCS_Array is array - (Natural range 0 .. Old_Length, - Natural range 0 .. New_Length) of Integer; - type LCS_Array_Access is access all LCS_Array; - - procedure Free is - new Ada.Unchecked_Deallocation (LCS_Array, LCS_Array_Access); - - LCS : LCS_Array_Access := new LCS_Array; - Match : Integer; - Delete : Integer; - Insert : Integer; - - Old_Index : Natural := Old_Length; - New_Index : Natural := New_Length; - - Old_Natural : Natural; - -- needed to determine which line number in the old buffer is - -- changed, deleted or before which new lines are inserted - - Changed_Block_Text : VSS.Strings.Virtual_String; - Changed_Block_Span : LSP.Structures.A_Range := ((0, 0), (0, 0)); - - procedure Prepare - (Line : Natural; - Text : VSS.Strings.Virtual_String); - -- Store imformation for Text_Etid in New_String and Span - - procedure Add (From_Line : Natural); - -- Add prepared New_String and Span into Text_Edit - - ------------- - -- Prepare -- - ------------- - - procedure Prepare - (Line : Natural; - Text : VSS.Strings.Virtual_String) is - begin - if Changed_Block_Span.an_end = (0, 0) then - -- it is the first portion of a changed block so store - -- last position of the changes - Changed_Block_Span.an_end := (Line, 0); - end if; - - -- accumulating new text for the changed block - Changed_Block_Text.Prepend (Text); - end Prepare; - - --------- - -- Add -- - --------- - - procedure Add (From_Line : Natural) is - begin - if Changed_Block_Span.an_end = (0, 0) then - -- No information for Text_Edit - return; - end if; - - Changed_Block_Span.start := - (line => From_Line, - character => 0); - - Edit.Prepend - (LSP.Structures.TextEdit' - (a_range => Changed_Block_Span, - newText => Changed_Block_Text)); - - -- clearing - Changed_Block_Text.Clear; - Changed_Block_Span := ((0, 0), (0, 0)); - end Add; - - begin - -- prepare LCS - - -- default values for line 0 - for Index in 0 .. Old_Length loop - LCS (Index, 0) := -5 * Index; - end loop; - - -- default values for the first column - for Index in 0 .. New_Length loop - LCS (0, Index) := -5 * Index; - end loop; - - -- calculate LCS - for Row in 1 .. Old_Length loop - for Column in 1 .. New_Length loop - Match := LCS (Row - 1, Column - 1) + - (if Old_Lines (Old_First_Line + Row - 1) = - New_Lines (New_First_Line + Column - 1) - then 10 -- +10 is the 'weight' for equal lines - else -1); -- and -1 for the different - - Delete := LCS (Row - 1, Column) - 5; - Insert := LCS (Row, Column - 1) - 5; - - LCS (Row, Column) := Integer'Max (Match, Insert); - LCS (Row, Column) := Integer'Max (LCS (Row, Column), Delete); - end loop; - end loop; - - -- iterate over LCS and create Text_Edit - - Old_Natural := Natural (Old_First_Line + Old_Length - 1); - - while Old_Index > 0 - and then New_Index > 0 - loop - if LCS (Old_Index, New_Index) = - LCS (Old_Index - 1, New_Index - 1) + - (if Old_Lines (Old_First_Line + Old_Index - 1) = - New_Lines (New_First_Line + New_Index - 1) - then 10 - else -1) - then - -- both has lines - if New_Lines.Element (New_First_Line + New_Index - 1) = - Old_Lines.Element (Old_First_Line + Old_Index - 1) - then - -- lines are equal, add Text_Edit after current line - -- if any is already prepared - Add (Old_Natural); - else - -- lines are different, change old line by new one, - -- we deleted whole line so 'To' position will be - -- the beginning of the next line - Prepare - (Old_Natural, - New_Lines.Element (New_First_Line + New_Index - 1)); - end if; - - -- move lines cursor backward - Old_Natural := Old_Natural - 1; - - New_Index := New_Index - 1; - Old_Index := Old_Index - 1; - - elsif LCS (Old_Index, New_Index) = - LCS (Old_Index - 1, New_Index) - 5 - then - -- line has been deleted, move lines cursor backward - Prepare (Old_Natural, VSS.Strings.Empty_Virtual_String); - - Old_Natural := Old_Natural - 1; - Old_Index := Old_Index - 1; - - elsif LCS (Old_Index, New_Index) = - LCS (Old_Index, New_Index - 1) - 5 - then - -- line has been inserted - -- insert Text_Edit information with insertion after - -- current line, do not move lines cursor because it is - -- additional line not present in the old document - Prepare - (Old_Natural, - New_Lines.Element (New_First_Line + New_Index - 1)); - - New_Index := New_Index - 1; - end if; - end loop; - - while Old_Index > 0 loop - -- deleted - Prepare (Old_Natural, VSS.Strings.Empty_Virtual_String); - - Old_Natural := Old_Natural - 1; - Old_Index := Old_Index - 1; - end loop; - - while New_Index > 0 loop - -- inserted - Prepare - (Old_Natural, - New_Lines.Element (New_First_Line + New_Index - 1)); - - New_Index := New_Index - 1; - end loop; - - Add (Old_Natural); - Free (LCS); - - -- Handle the edge case where the last location of - -- the edit is trying to affect a non existent line. - -- The edits are ordered so we only need to check the last one. - - if not Edit.Is_Empty - and then not Self.Line_To_Marker.Is_Empty - and then Edit.Last_Element.a_range.an_end.line not in - Self.Line_To_Marker.First_Index .. Self.Line_To_Marker.Last_Index - then - declare - use type VSS.Unicode.UTF16_Code_Unit_Offset; - - Element : LSP.Structures.TextEdit := Edit.Last_Element; - Last_Line : constant VSS.Strings.Virtual_String := - Old_Lines (Old_Lines.Length); - Iterator : - constant VSS.Strings.Character_Iterators.Character_Iterator := - Last_Line.At_Last_Character; - - begin - -- Replace the wrong location by the end of the buffer - Element.a_range.an_end := - (line => Natural (Old_Lines.Length) - 1, - character => Natural (Iterator.Last_UTF16_Offset) + 1); - Edit.Replace_Element (Edit.Last, Element); - end; - end if; - - exception - when others => - Free (LCS); - raise; - end; - end Diff; - - ------------------ - -- Diff_Symbols -- - ------------------ - - procedure Diff_Symbols - (Self : Document; - Span : LSP.Structures.A_Range; - New_Text : VSS.Strings.Virtual_String; - Edit : in out LSP.Structures.TextEdit_Vector) - is - use VSS.Strings; - use VSS.Characters; - - Old_Text : VSS.Strings.Virtual_String; - Old_Lines : VSS.String_Vectors.Virtual_String_Vector; - Old_Line : VSS.Strings.Virtual_String; - Old_Length, New_Length : Natural; - - First_Marker : VSS.Strings.Markers.Character_Marker; - Last_Marker : VSS.Strings.Markers.Character_Marker; - - begin - Self.Span_To_Markers (Span, First_Marker, Last_Marker); - - Old_Text := Self.Text.Slice (First_Marker, Last_Marker); - Old_Lines := Old_Text.Split_Lines - (Terminators => LSP_New_Line_Function_Set, - Keep_Terminator => True); - Old_Line := Old_Lines.Element (Old_Lines.Length); - - Old_Length := Integer (Character_Length (Old_Text)); - New_Length := Integer (Character_Length (New_Text)); - - declare - type LCS_Array is array - (Natural range 0 .. Old_Length, - Natural range 0 .. New_Length) of Integer; - type LCS_Array_Access is access all LCS_Array; - - procedure Free is - new Ada.Unchecked_Deallocation (LCS_Array, LCS_Array_Access); - - LCS : LCS_Array_Access := new LCS_Array; - Match : Integer; - Delete : Integer; - Insert : Integer; - - Old_Char : VSS.Strings.Character_Iterators.Character_Iterator := - Old_Text.At_First_Character; - - New_Char : VSS.Strings.Character_Iterators.Character_Iterator := - New_Text.At_First_Character; - - Dummy : Boolean; - - Old_Index, New_Index : Integer; - - Changed_Block_Text : VSS.Strings.Virtual_String; - Changed_Block_Span : LSP.Structures.A_Range := ((0, 0), (0, 0)); - Span_Set : Boolean := False; - - -- to calculate span - Current_Natural : Natural := - (if Natural (Span.an_end.character) = 0 - then Span.an_end.line - 1 - else Span.an_end.line); - -- we do not have a line at all when the range end is on the - -- begin of a line, so set Current_Natural to the previous one - Old_Lines_Number : Natural := Old_Lines.Length; - - Cursor : VSS.Strings.Character_Iterators.Character_Iterator := - Old_Line.After_Last_Character; - - procedure Backward; - -- Move old line Cursor backward, update Old_Line and - -- Old_Lines_Number if needed - - function Get_Position - (Insert : Boolean) return LSP.Structures.Position; - -- get Position for a Span based on Cursor to prepare first/last - -- position for changes - - procedure Prepare_Last_Span (Insert : Boolean); - -- Store position based on Cursor to Changed_Block_Span.an_end if - -- it is not stored yet - - procedure Prepare_Change - (Insert : Boolean; - Char : VSS.Characters.Virtual_Character); - -- Collect change information for Text_Edit in Changed_Block_Text - -- and Changed_Block_Span - - procedure Add_Prepared_Change; - -- Add prepared New_String and corresponding Span into Text_Edit - - -------------- - -- Backward -- - -------------- - - procedure Backward is - begin - if not Cursor.Backward - and then Old_Lines_Number > 1 - then - Current_Natural := Current_Natural - 1; - Old_Lines_Number := Old_Lines_Number - 1; - Old_Line := Old_Lines.Element (Old_Lines_Number); - Cursor.Set_At_Last (Old_Line); - end if; - - Old_Index := Old_Index - 1; - Dummy := Old_Char.Backward; - end Backward; - - ------------------ - -- Get_Position -- - ------------------ - - function Get_Position - (Insert : Boolean) return LSP.Structures.Position - is - -------------- - -- Backward -- - -------------- - - function Backward return LSP.Structures.Position; - - function Backward return LSP.Structures.Position is - C : VSS.Strings.Character_Iterators.Character_Iterator := - Old_Line.At_Character (Cursor); - begin - -- "Cursor" is after the current character but we should - -- insert before it - if C.Backward then - return - (line => Current_Natural, - character => Natural (C.First_UTF16_Offset)); - else - return - (line => Current_Natural, - character => 0); - end if; - end Backward; - - begin - if not Cursor.Has_Element then - return - (line => Current_Natural, - character => 0); - - elsif Insert then - -- "Cursor" is after the current character but we should - -- insert before it - return Backward; - - else - return - (line => Current_Natural, - character => Natural (Cursor.First_UTF16_Offset)); - end if; - end Get_Position; - - ----------------------- - -- Prepare_Last_Span -- - ----------------------- - - procedure Prepare_Last_Span (Insert : Boolean) is - begin - if not Span_Set then - -- it is the first portion of a changed block so store - -- last position of the changes - Span_Set := True; - Changed_Block_Span.an_end := Get_Position (Insert); - end if; - end Prepare_Last_Span; - - -------------------- - -- Prepare_Change -- - -------------------- - - procedure Prepare_Change - (Insert : Boolean; - Char : VSS.Characters.Virtual_Character) is - begin - Prepare_Last_Span (Insert); - -- accumulating new text for the changed block - Changed_Block_Text.Prepend (Char); - end Prepare_Change; - - ------------------------- - -- Add_Prepared_Change -- - ------------------------- - - procedure Add_Prepared_Change is - begin - if not Span_Set then - -- No information for Text_Edit - return; - end if; - - Changed_Block_Span.start := Get_Position (False); - - Edit.Prepend - (LSP.Structures.TextEdit' - (a_range => Changed_Block_Span, - newText => Changed_Block_Text)); - - -- clearing - Changed_Block_Text.Clear; - - Changed_Block_Span := ((0, 0), (0, 0)); - Span_Set := False; - end Add_Prepared_Change; - - begin - -- prepare LCS - - -- default values for line 0 - for Index in 0 .. Old_Length loop - LCS (Index, 0) := -5 * Index; - end loop; - - -- default values for the first column - for Index in 0 .. New_Length loop - LCS (0, Index) := -5 * Index; - end loop; - - -- calculate LCS - for Row in 1 .. Old_Length loop - New_Char.Set_At_First (New_Text); - for Column in 1 .. New_Length loop - Match := LCS (Row - 1, Column - 1) + - (if Old_Char.Element = New_Char.Element - then 10 -- +10 is the 'weight' for equal lines - else -1); -- and -1 for the different - - Delete := LCS (Row - 1, Column) - 5; - Insert := LCS (Row, Column - 1) - 5; - - LCS (Row, Column) := Integer'Max (Match, Insert); - LCS (Row, Column) := Integer'Max (LCS (Row, Column), Delete); - - Dummy := New_Char.Forward; - end loop; - Dummy := Old_Char.Forward; - end loop; - - -- iterate over LCS and create Text_Edit - - Old_Char.Set_At_Last (Old_Text); - New_Char.Set_At_Last (New_Text); - Old_Index := Old_Length; - New_Index := New_Length; - - while Old_Index > 0 - and then New_Index > 0 - loop - if LCS (Old_Index, New_Index) = - LCS (Old_Index - 1, New_Index - 1) + - (if Old_Char.Element = New_Char.Element - then 10 - else -1) - then - -- both has elements - if Old_Char.Element = New_Char.Element then - -- elements are equal, add prepared Text_Edit - Add_Prepared_Change; - else - -- elements are different, change old one by new - Prepare_Change (False, New_Char.Element); - end if; - - -- move old element cursors backward - Backward; - - New_Index := New_Index - 1; - Dummy := New_Char.Backward; - - elsif LCS (Old_Index, New_Index) = - LCS (Old_Index - 1, New_Index) - 5 - then - -- element has been deleted, move old cursor backward - Prepare_Last_Span (False); - Backward; - - elsif LCS (Old_Index, New_Index) = - LCS (Old_Index, New_Index - 1) - 5 - then - -- element has been inserted - Prepare_Change (True, New_Char.Element); - - New_Index := New_Index - 1; - Dummy := New_Char.Backward; - end if; - end loop; - - while Old_Index > 0 loop - -- deleted - Prepare_Last_Span (False); - Backward; - end loop; - - while New_Index > 0 loop - -- inserted - Prepare_Change (True, New_Char.Element); - - New_Index := New_Index - 1; - Dummy := New_Char.Backward; - end loop; - - Add_Prepared_Change; - Free (LCS); - - exception - when others => - Free (LCS); - raise; - end; - end Diff_Symbols; - ------------------------- -- Find_All_References -- ------------------------- @@ -1046,10 +338,7 @@ package body LSP.Ada_Documents is Sloc : constant Libadalang.Slocs.Source_Location_Range := (if Span = LSP.Constants.Empty then Libadalang.Slocs.No_Source_Location_Range - else Libadalang.Slocs.Make_Range - (Self.Get_Source_Location (Span.start), - Self.Get_Source_Location (Span.an_end))); - + else Self.To_Source_Location_Range (Span)); Input : Utils.Char_Vectors.Char_Vector; Output : Utils.Char_Vectors.Char_Vector; Out_Span : LSP.Structures.A_Range; @@ -1129,9 +418,8 @@ package body LSP.Ada_Documents is if Span = LSP.Constants.Empty then -- diff for the whole document - Diff - (Self, - VSS.Strings.Conversions.To_Virtual_String (S.all), + Self.Diff + (VSS.Strings.Conversions.To_Virtual_String (S.all), Edit => Edit); elsif Out_Sloc = Libadalang.Slocs.No_Source_Location_Range then @@ -1142,14 +430,13 @@ package body LSP.Ada_Documents is else -- diff for a part of the document - Out_Span := Self.To_LSP_Range (Out_Sloc); + Out_Span := Self.To_A_Range (Out_Sloc); -- Use line diff if the range is too wide if Span.an_end.line - Span.start.line > 5 then - Diff - (Self, - VSS.Strings.Conversions.To_Virtual_String (S.all), + Self.Diff + (VSS.Strings.Conversions.To_Virtual_String (S.all), Span, Out_Span, Edit); @@ -1163,11 +450,7 @@ package body LSP.Ada_Documents is begin LSP.Utils.Span_To_Slice (Formatted, Out_Span, Slice); - Diff_Symbols - (Self, - Span, - Slice, - Edit); + Self.Diff_Symbols (Span, Slice, Edit); end; end if; end if; @@ -1426,7 +709,7 @@ package body LSP.Ada_Documents is return Token; end Completion_Token; begin - Sloc := Self.Get_Source_Location (Position); + Sloc := Self.To_Source_Location (Position); Token := Completion_Token (Sloc); declare From : constant Langkit_Support.Slocs.Source_Location := @@ -1747,10 +1030,10 @@ package body LSP.Ada_Documents is if not foldingRange.kind.Is_Set then foldingRange.kind := (Is_Set => True, Value => LSP.Enumerations.Comment); - Span := Self.To_LSP_Range (Sloc_Range (Data (Token))); + Span := Self.To_A_Range (Sloc_Range (Data (Token))); else Span.an_end := - Self.To_LSP_Range (Sloc_Range (Data (Token))).an_end; + Self.To_A_Range (Sloc_Range (Data (Token))).an_end; end if; when Ada_Whitespace => @@ -1779,9 +1062,7 @@ package body LSP.Ada_Documents is is (Laltools.Partial_GNATPP.Get_Formatting_Region (Unit => Self.Unit (Context), Input_Range => - Langkit_Support.Slocs.Make_Range - (Self.Get_Source_Location (Position), - Self.Get_Source_Location (Position)))); + Self.To_Source_Location_Range ((Position, Position)))); --------------------- -- Get_Indentation -- @@ -1796,7 +1077,7 @@ package body LSP.Ada_Documents is (VSS.Strings.Character_Count (Laltools.Partial_GNATPP.Estimate_Indentation (Self.Unit (Context), - Self.Get_Source_Location ((Line, 1)).Line))); + Self.To_Source_Location ((Line, 1)).Line))); ----------------- -- Get_Node_At -- @@ -1810,41 +1091,9 @@ package body LSP.Ada_Documents is Unit : constant Libadalang.Analysis.Analysis_Unit := Self.Unit (Context); begin return (if Unit.Root.Is_Null then Libadalang.Analysis.No_Ada_Node - else Unit.Root.Lookup (Self.Get_Source_Location (Position))); + else Unit.Root.Lookup (Self.To_Source_Location (Position))); end Get_Node_At; - ------------------------- - -- Get_Source_Location -- - ------------------------- - - function Get_Source_Location - (Self : Document'Class; Position : LSP.Structures.Position) - return Langkit_Support.Slocs.Source_Location - is - use type VSS.Unicode.UTF16_Code_Unit_Offset; - use type VSS.Strings.Character_Index; - - Iterator : VSS.Strings.Character_Iterators.Character_Iterator := - Self.Text.At_Character (Self.Line_To_Marker (Position.line)); - - Line_Offset : constant VSS.Unicode.UTF16_Code_Unit_Offset := - Iterator.First_UTF16_Offset; - - Line_First_Character : constant VSS.Strings.Character_Index := - Iterator.Character_Index; - begin - while Integer (Iterator.First_UTF16_Offset - Line_Offset) - <= Position.character - and then Iterator.Forward - loop - null; - end loop; - - return ((Line => Langkit_Support.Slocs.Line_Number (Position.line + 1), - Column => Langkit_Support.Slocs.Column_Number - (Iterator.Character_Index - Line_First_Character))); - end Get_Source_Location; - -------------------------- -- Get_Symbol_Hierarchy -- -------------------------- @@ -1876,24 +1125,6 @@ package body LSP.Ada_Documents is raise Program_Error with "Unimplemented procedure Get_Symbols"; end Get_Symbols; - ----------------- - -- Get_Text_At -- - ----------------- - - function Get_Text_At - (Self : Document; Start_Pos : LSP.Structures.Position; - End_Pos : LSP.Structures.Position) return VSS.Strings.Virtual_String - is - First_Marker : VSS.Strings.Markers.Character_Marker; - Last_Marker : VSS.Strings.Markers.Character_Marker; - - begin - Self.Span_To_Markers - ((Start_Pos, End_Pos), First_Marker, Last_Marker); - - return Self.Text.Slice (First_Marker, Last_Marker); - end Get_Text_At; - ------------------ -- Get_Token_At -- ------------------ @@ -1903,7 +1134,7 @@ package body LSP.Ada_Documents is Position : LSP.Structures.Position) return Libadalang.Common.Token_Reference is - (Self.Unit (Context).Lookup_Token (Self.Get_Source_Location (Position))); + (Self.Unit (Context).Lookup_Token (Self.To_Source_Location (Position))); ---------------- -- Get_Tokens -- @@ -1934,7 +1165,7 @@ package body LSP.Ada_Documents is Unit : constant Libadalang.Analysis.Analysis_Unit := Self.Unit (Context); - Origin : constant Source_Location := Self.Get_Source_Location (Position); + Origin : constant Source_Location := Self.To_Source_Location (Position); Where : constant Source_Location := (Origin.Line, Origin.Column - 1); -- Compute the position we want for completion, which is one character -- before the cursor. @@ -1985,42 +1216,17 @@ package body LSP.Ada_Documents is (Self : in out Document; URI : LSP.Structures.DocumentUri; Text : VSS.Strings.Virtual_String; - Diagnostic : LSP.Diagnostic_Sources.Diagnostic_Source_Access) - is + Diagnostic : LSP.Diagnostic_Sources.Diagnostic_Source_Access) is begin - Self.URI := URI; - Self.Version := 1; - Self.Text := Text; - Self.Refresh_Symbol_Cache := True; + LSP.Text_Documents.Constructors.Initialize (Self, URI, Text); + + Self.Refresh_Symbol_Cache := True; Self.Diagnostic_Sources (1) := new LSP.Ada_Documents.LAL_Diagnostics.Diagnostic_Source (Self'Unchecked_Access); - Self.Diagnostic_Sources (2) := Diagnostic; - Recompute_Indexes (Self); + Self.Diagnostic_Sources (2) := Diagnostic; end Initialize; - --------------------- - -- Line_Terminator -- - --------------------- - - function Line_Terminator - (Self : Document'Class) return VSS.Strings.Virtual_String - is - use type VSS.Strings.Virtual_String; - - begin - return - (if Self.Line_Terminator.Is_Empty then - -- Document has no line terminator yet, return LF as most used - -- - -- Should it be platform specific? CRLF for Windows, CR for Mac? - - 1 * VSS.Characters.Latin.Line_Feed - - else - Self.Line_Terminator); - end Line_Terminator; - ---------------------- -- Range_Formatting -- ---------------------- @@ -2078,10 +1284,9 @@ package body LSP.Ada_Documents is Unit : constant Analysis_Unit := Self.Unit (Context); Input_Selection_Range : constant Source_Location_Range := - (if Span = Empty_Range then No_Source_Location_Range - else Make_Range - (Self.Get_Source_Location (Span.start), - Self.Get_Source_Location (Span.an_end))); + (if Span = LSP.Text_Documents.Empty_Range + then No_Source_Location_Range + else Self.To_Source_Location_Range (Span)); Partial_Formatting_Edit : constant Laltools.Partial_GNATPP.Partial_Formatting_Edit := Format_Selection (Unit, Input_Selection_Range, PP_Options); @@ -2099,7 +1304,7 @@ package body LSP.Ada_Documents is Edit.Clear; declare Edit_Span : constant LSP.Structures.A_Range := - Self.To_LSP_Range (Partial_Formatting_Edit.Edit.Location); + Self.To_A_Range (Partial_Formatting_Edit.Edit.Location); Edit_Text : constant VSS.Strings.Virtual_String := VSS.Strings.Conversions.To_Virtual_String (Partial_Formatting_Edit.Edit.Text); @@ -2117,100 +1322,6 @@ package body LSP.Ada_Documents is return False; end Range_Formatting; - ----------------------- - -- Recompute_Indexes -- - ----------------------- - - procedure Recompute_Indexes (Self : in out Document'Class) is - use type VSS.Strings.Character_Count; - - begin - Self.Line_To_Marker.Clear; - - -- To avoid too many reallocations during the initial filling - -- of the index vector, pre-allocate it. Give a generous - -- pre-allocation assuming that there is a line break every - -- 20 characters on average (this file has one line break - -- every 33 characters). - Self.Line_To_Marker.Reserve_Capacity - (Ada.Containers.Count_Type (Self.Text.Character_Length / 20)); - - declare - J : VSS.Strings.Line_Iterators.Line_Iterator := - Self.Text.At_First_Line - (Terminators => LSP_New_Line_Function_Set, - Keep_Terminator => True); - Last_Line_Terminated : Boolean := False; - - begin - if J.Has_Element then - -- Update Line_Terminator of the document - Self.Line_Terminator := Self.Text.Slice - (J.Terminator_First_Marker, J.Terminator_Last_Marker); - - loop - Self.Line_To_Marker.Append (J.First_Marker); - Last_Line_Terminated := J.Has_Line_Terminator; - - exit when not J.Forward; - end loop; - - else - Last_Line_Terminated := True; - -- Force to add one line for an empty document. - end if; - - -- Append marker at the end of the text when the last line has line - -- terminator sequence or text is empty. It allows to avoid checks - -- for corner cases. - - if Last_Line_Terminated then - Self.Line_To_Marker.Append (J.First_Marker); - end if; - end; - end Recompute_Indexes; - - ----------------------- - -- Recompute_Markers -- - ----------------------- - - procedure Recompute_Markers - (Self : in out Document'Class; - Low_Line : Natural; - Start_Marker : VSS.Strings.Markers.Character_Marker; - End_Marker : VSS.Strings.Markers.Character_Marker) - is - use type VSS.Strings.Character_Count; - - M : VSS.Strings.Markers.Character_Marker; - J : VSS.Strings.Line_Iterators.Line_Iterator := - Self.Text.At_Line - (Position => Start_Marker, - Terminators => LSP_New_Line_Function_Set, - Keep_Terminator => True); - Line : Natural := Low_Line; - - begin - if J.Has_Element then - loop - M := J.First_Marker; - - exit - when End_Marker.Is_Valid - and then M.Character_Index = End_Marker.Character_Index; - - Self.Line_To_Marker.Insert (Line, M); - Line := Line + 1; - - exit when not J.Forward; - end loop; - - if not End_Marker.Is_Valid then - Self.Line_To_Marker.Append (J.First_Marker); - end if; - end if; - end Recompute_Markers; - ------------------------ -- Reset_Symbol_Cache -- ------------------------ @@ -2285,49 +1396,6 @@ package body LSP.Ada_Documents is end if; end Set_Completion_Item_Documentation; - --------------------- - -- Span_To_Markers -- - --------------------- - - procedure Span_To_Markers - (Self : Document'Class; - Span : LSP.Structures.A_Range; - From : out VSS.Strings.Markers.Character_Marker; - To : out VSS.Strings.Markers.Character_Marker) - is - use type VSS.Unicode.UTF16_Code_Unit_Offset; - - J1 : VSS.Strings.Character_Iterators.Character_Iterator := - Self.Text.At_Character (Self.Line_To_Marker (Span.start.line)); - U1 : constant VSS.Unicode.UTF16_Code_Unit_Offset := - J1.First_UTF16_Offset; - - J2 : VSS.Strings.Character_Iterators.Character_Iterator := - Self.Text.At_Character (Self.Line_To_Marker (Span.an_end.line)); - U2 : constant VSS.Unicode.UTF16_Code_Unit_Offset := - J2.First_UTF16_Offset; - - Dummy : Boolean; - - begin - while Span.start.character /= Integer (J1.First_UTF16_Offset - U1) - and then J1.Forward - loop - null; - end loop; - - From := J1.Marker; - - while Span.an_end.character /= Integer (J2.First_UTF16_Offset - U2) - and then J2.Forward - loop - null; - end loop; - - Dummy := J2.Backward; - To := J2.Marker; - end Span_To_Markers; - --------------------- -- To_LSP_Location -- --------------------- @@ -2338,70 +1406,9 @@ package body LSP.Ada_Documents is Kinds : LSP.Structures.AlsReferenceKind_Set := LSP.Constants.Empty) return LSP.Structures.Location is (uri => Self.URI, - a_range => Self.To_LSP_Range (Segment), + a_range => Self.To_A_Range (Segment), alsKind => Kinds); - ------------------ - -- To_LSP_Range -- - ------------------ - - function To_LSP_Range - (Self : Document; - Segment : Langkit_Support.Slocs.Source_Location_Range) - return LSP.Structures.A_Range - is - - Start_Line : constant Natural := Natural (Segment.Start_Line) - 1; - - Start_Line_Text : constant VSS.Strings.Virtual_String := - (if Self.Line_To_Marker.Last_Index = Start_Line then - Self.Text.Slice - (Self.Line_To_Marker (Start_Line), Self.Text.After_Last_Character) - else - Self.Text.Slice - (Self.Line_To_Marker (Start_Line), - Self.Line_To_Marker (Start_Line + 1))); - Start_Iterator : VSS.Strings.Character_Iterators.Character_Iterator := - Start_Line_Text.At_First_Character; - - End_Line : constant Natural := Natural (Segment.End_Line) - 1; - End_Line_Text : constant VSS.Strings.Virtual_String := - (if Self.Line_To_Marker.Last_Index = End_Line then - Self.Text.Slice - (Self.Line_To_Marker (End_Line), Self.Text.After_Last_Character) - else - Self.Text.Slice - (Self.Line_To_Marker (End_Line), - Self.Line_To_Marker (End_Line + 1))); - End_Iterator : VSS.Strings.Character_Iterators.Character_Iterator := - End_Line_Text.At_First_Character; - Success : Boolean with Unreferenced; - - begin - -- Iterating forward through the line of the start position, initial - -- iterator points to the first characters, thus "starts" from the - -- second one. - - for J in 2 .. Segment.Start_Column loop - Success := Start_Iterator.Forward; - end loop; - - -- Iterating forward through the line of the end position. For the same - -- reason "starts" from second character. - - for J in 2 .. Segment.End_Column loop - Success := End_Iterator.Forward; - end loop; - - return - (start => - (line => Start_Line, - character => Natural (Start_Iterator.First_UTF16_Offset)), - an_end => - (line => End_Line, - character => Natural (End_Iterator.Last_UTF16_Offset))); - end To_LSP_Range; - ---------- -- Unit -- ---------- @@ -2415,12 +1422,4 @@ package body LSP.Ada_Documents is Charset => Context.Charset, Reparse => False)); - -------------------------- - -- Versioned_Identifier -- - -------------------------- - - function Versioned_Identifier - (Self : Document) return LSP.Structures.VersionedTextDocumentIdentifier - is (Self.URI, Self.Version); - end LSP.Ada_Documents; diff --git a/source/ada/lsp-ada_documents.ads b/source/ada/lsp-ada_documents.ads index 474425fac..ae498ef5c 100644 --- a/source/ada/lsp-ada_documents.ads +++ b/source/ada/lsp-ada_documents.ads @@ -21,7 +21,6 @@ with Ada.Containers.Ordered_Maps; with Ada.Containers.Vectors; with VSS.String_Vectors; with VSS.Strings; -private with VSS.Strings.Markers; with Libadalang.Analysis; with Libadalang.Common; @@ -36,6 +35,7 @@ with LSP.Ada_Completions; with LSP.Ada_Highlighters; with LSP.Constants; with LSP.Diagnostic_Sources; +with LSP.Text_Documents.Langkit_Documents; with LSP.Search; with LSP.Structures; with LSP.Tracers; @@ -44,13 +44,9 @@ package LSP.Ada_Documents is MAX_NB_DIAGNOSTICS : constant := 2; - LSP_New_Line_Function_Set : constant VSS.Strings.Line_Terminator_Set := - (VSS.Strings.CR | VSS.Strings.CRLF | VSS.Strings.LF => True, - others => False); - -- LSP allows to use three kinds of line terminators: CR, CR+LF and LF. - type Document (Tracer : not null LSP.Tracers.Tracer_Access) is - tagged limited private; + new LSP.Text_Documents.Langkit_Documents.Langkit_Text_Document + with private; -- An Ada document (file). type Document_Access is access all LSP.Ada_Documents.Document @@ -67,28 +63,6 @@ package LSP.Ada_Documents is procedure Cleanup (Self : in out Document); -- Free all the data associated to this document. - ----------------------- - -- Contents handling -- - ----------------------- - - function URI (Self : Document) return LSP.Structures.DocumentUri; - -- Return the URI associated with Self - - function Text (Self : Document) return VSS.Strings.Virtual_String; - -- Return the text associated with Self - - function Get_Text_At - (Self : Document; - Start_Pos : LSP.Structures.Position; - End_Pos : LSP.Structures.Position) return VSS.Strings.Virtual_String; - -- Return the text in the specified range. - - function To_LSP_Range - (Self : Document; - Segment : Langkit_Support.Slocs.Source_Location_Range) - return LSP.Structures.A_Range; - -- Convert LAL's Source_Location_Range to LSP's Range - function To_LSP_Location (Self : Document; Segment : Langkit_Support.Slocs.Source_Location_Range; @@ -96,15 +70,6 @@ package LSP.Ada_Documents is return LSP.Structures.Location; -- Convert LAL's Source_Location_Range and document's uri to a LSP location - procedure Apply_Changes - (Self : aliased in out Document; - Version : Integer; - Vector : LSP.Structures.TextDocumentContentChangeEvent_Vector); - -- Modify document according to event vector provided by LSP client. - - function Versioned_Identifier - (Self : Document) return LSP.Structures.VersionedTextDocumentIdentifier; - -------------- -- Requests -- -------------- @@ -314,16 +279,6 @@ package LSP.Ada_Documents is -- Either set the item documentation and details or setup it to produce -- them for the Completion_Resolve request. - function Get_Source_Location - (Self : Document'Class; - Position : LSP.Structures.Position) - return Langkit_Support.Slocs.Source_Location; - -- Convert a Positon to a Source_Location - - function Line_Terminator - (Self : Document'Class) return VSS.Strings.Virtual_String; - -- Return line terminator for the document - function Get_Token_At (Self : Document'Class; Context : LSP.Ada_Contexts.Context; @@ -341,11 +296,6 @@ package LSP.Ada_Documents is private - package Line_Marker_Vectors is new Ada.Containers.Vectors - (Index_Type => Natural, - Element_Type => VSS.Strings.Markers.Character_Marker, - "=" => VSS.Strings.Markers."="); - type Name_Information is record Loc : Langkit_Support.Slocs.Source_Location; Is_Public : Boolean; @@ -364,61 +314,15 @@ private LSP.Diagnostic_Sources.Diagnostic_Source_Access; type Document (Tracer : not null LSP.Tracers.Tracer_Access) is - tagged limited - record - URI : LSP.Structures.DocumentUri; - - Version : Integer := 1; - -- Document version - - Text : VSS.Strings.Virtual_String; - -- The text of the document - - Line_To_Marker : Line_Marker_Vectors.Vector; - -- Within text, an array associating a line number (starting at 0) to - -- the marker of the first character of that line in Text. - -- This serves as cache to be able to modify text ranges in Text - -- given in line/column coordinates without having to scan the whole - -- text from the beginning. - + new LSP.Text_Documents.Langkit_Documents.Langkit_Text_Document with record Symbol_Cache : Symbol_Maps.Map; -- Cache of all defining name symbol of the document. Refresh_Symbol_Cache : Boolean := False; -- Symbol_Cache rebuild is required before. - Line_Terminator : VSS.Strings.Virtual_String; - -- Line terminator for the text, if known, "" otherwise Diagnostic_Sources : Diagnostic_Source_Array (1 .. 2); -- Known sources of diagnostics end record; - Empty_Range : LSP.Structures.A_Range := ((1, 1), (0, 0)); - - procedure Diff - (Self : Document; - New_Text : VSS.Strings.Virtual_String; - Old_Span : LSP.Structures.A_Range := Empty_Range; - New_Span : LSP.Structures.A_Range := Empty_Range; - Edit : out LSP.Structures.TextEdit_Vector); - -- Create a diff between document Text and New_Text and return Text_Edit - -- based on Needleman-Wunsch algorithm. - -- Old_Span and New_Span are used when we need to compare certain - -- old/new lines instead of whole buffers. - - procedure Diff_Symbols - (Self : Document; - Span : LSP.Structures.A_Range; - New_Text : VSS.Strings.Virtual_String; - Edit : in out LSP.Structures.TextEdit_Vector); - -- Create a diff between document Text inside Span and New_Chunk and - -- return Text_Edit. Tests individual symbols instead of lines - -- as above. Do not use it for large text slices because it - -- creates an N^M map for symbols. - - function URI (Self : Document) return LSP.Structures.DocumentUri is - (Self.URI); - function Text (Self : Document) return VSS.Strings.Virtual_String is - (Self.Text); - function Unit (Self : Document'Class; Context : LSP.Ada_Contexts.Context) diff --git a/source/ada/lsp-ada_handlers-locations.adb b/source/ada/lsp-ada_handlers-locations.adb index 937860cd6..1fc3342b9 100644 --- a/source/ada/lsp-ada_handlers-locations.adb +++ b/source/ada/lsp-ada_handlers-locations.adb @@ -75,7 +75,7 @@ package body LSP.Ada_Handlers.Locations is if File = Node_File then Result.Append (LSP.Structures.DocumentHighlight' - (a_range => Document.To_LSP_Range (Node.Sloc_Range), + (a_range => Document.To_A_Range (Node.Sloc_Range), kind => Kind)); end if; end Append_Location; diff --git a/source/ada/lsp-ada_handlers-named_parameters_commands.adb b/source/ada/lsp-ada_handlers-named_parameters_commands.adb index fceee8095..68396ef56 100644 --- a/source/ada/lsp-ada_handlers-named_parameters_commands.adb +++ b/source/ada/lsp-ada_handlers-named_parameters_commands.adb @@ -212,8 +212,6 @@ package body LSP.Ada_Handlers.Named_Parameters_Commands is Args : Libadalang.Analysis.Basic_Assoc_List; Params : VSS.String_Vectors.Virtual_String_Vector; Index : Natural := 0; - Version : constant LSP.Structures.VersionedTextDocumentIdentifier := - Document.Versioned_Identifier; begin Apply.label := VSS.Strings.Conversions.To_Virtual_String @@ -225,10 +223,7 @@ package body LSP.Ada_Handlers.Named_Parameters_Commands is (Kind => documentChanges_OfWorkspaceEdit_Item_Variant'(Variant_1), Variant_1 => - (textDocument => - (uri => Version.uri, - version => (Is_Null => False, - Value => Version.version)), + (textDocument => Document.Identifier, edits => <>))); end if; diff --git a/source/ada/lsp-ada_handlers.adb b/source/ada/lsp-ada_handlers.adb index ba90149ef..5b99b61ff 100644 --- a/source/ada/lsp-ada_handlers.adb +++ b/source/ada/lsp-ada_handlers.adb @@ -345,10 +345,7 @@ package body LSP.Ada_Handlers is return (URI, LSP.Structures.Integer_Or_Null'(Is_Null => True)); else - return - (uri => Document.Versioned_Identifier.uri, - version => (Is_Null => False, - Value => Document.Versioned_Identifier.version)); + return Document.Identifier; end if; end Get_Open_Document_Version; @@ -3540,7 +3537,7 @@ package body LSP.Ada_Handlers is Laltools.Partial_GNATPP.Previous_Non_Whitespace_Non_Comment_Token (Token); Previous_NWNC_Token_Span : constant LSP.Structures.A_Range := - Document.To_LSP_Range + Document.To_A_Range (Libadalang.Common.Sloc_Range (Libadalang.Common.Data (Previous_NWNC_Token))); @@ -3549,7 +3546,7 @@ package body LSP.Ada_Handlers is Document.Get_Formatting_Region (Context.all, Previous_NWNC_Token_Span.start); Formatting_Span : constant LSP.Structures.A_Range := - Document.To_LSP_Range + Document.To_A_Range (Libadalang.Slocs.Make_Range (Libadalang.Slocs.Start_Sloc (Libadalang.Common.Sloc_Range @@ -4263,7 +4260,7 @@ package body LSP.Ada_Handlers is Document : constant LSP.Ada_Documents.Document_Access := Self.Get_Open_Document (Value.textDocument.uri); Location : constant Langkit_Support.Slocs.Source_Location := - Document.Get_Source_Location (Value.position); + Document.To_Source_Location (Value.position); Position : LSP.Structures.Position := Value.position; Node : Libadalang.Analysis.Ada_Node; diff --git a/source/ada/lsp-utils.adb b/source/ada/lsp-utils.adb index d8c9db178..a034a1ab4 100644 --- a/source/ada/lsp-utils.adb +++ b/source/ada/lsp-utils.adb @@ -37,7 +37,7 @@ with VSS.String_Vectors; with VSS.Unicode; with Laltools.Common; -with LSP.Ada_Documents; +with LSP.Text_Documents; with LSP.Constants; with LSP.Formatters.File_Names; with URIs; @@ -521,7 +521,7 @@ package body LSP.Utils is begin Lines := Text.Split_Lines - (Terminators => LSP.Ada_Documents.LSP_New_Line_Function_Set, + (Terminators => LSP.Text_Documents.LSP_New_Line_Function_Set, Keep_Terminator => True); Line := Lines (Num); diff --git a/source/gpr/lsp-gpr_documents.adb b/source/gpr/lsp-gpr_documents.adb index 7a5f48d7f..f82015a76 100644 --- a/source/gpr/lsp-gpr_documents.adb +++ b/source/gpr/lsp-gpr_documents.adb @@ -15,149 +15,10 @@ -- of the license. -- ------------------------------------------------------------------------------ -with GNATCOLL.Traces; - with GPR2.Message; -with VSS.Characters.Latin; -with VSS.Strings.Character_Iterators; -with VSS.Strings.Conversions; -with VSS.Strings.Line_Iterators; -with VSS.Unicode; - package body LSP.GPR_Documents is - Document_Changes_Trace : constant GNATCOLL.Traces.Trace_Handle := - GNATCOLL.Traces.Create ("ALS.DOCUMENT_CHANGES", - GNATCOLL.Traces.Off); - -- Logging each document change - - LSP_New_Line_Function_Set : constant VSS.Strings.Line_Terminator_Set := - (VSS.Strings.CR | VSS.Strings.CRLF | VSS.Strings.LF => True, - others => False); - -- LSP allows to use three kinds of line terminators: CR, CR+LF and LF. - - procedure Span_To_Markers - (Self : Document'Class; - Span : LSP.Structures.A_Range; - From : out VSS.Strings.Markers.Character_Marker; - To : out VSS.Strings.Markers.Character_Marker); - - procedure Recompute_Indexes (Self : in out Document); - -- Recompute the line-to-offset indexes in Self - - procedure Recompute_Markers - (Self : in out Document'Class; - Low_Line : Natural; - Start_Marker : VSS.Strings.Markers.Character_Marker; - End_Marker : VSS.Strings.Markers.Character_Marker); - -- Recompute line-to-marker index starting from Start_Marker till - -- End_Marker and filling index table starting at Low_Line. End_Marker - -- may be invalid marker, in this case indexing down to the end of the - -- text. - - ------------------- - -- Apply_Changes -- - ------------------- - - procedure Apply_Changes - (Self : aliased in out Document; - Version : Integer; - Vector : LSP.Structures.TextDocumentContentChangeEvent_Vector) - is - URI : constant String := - VSS.Strings.Conversions.To_UTF_8_String (Self.URI); - - begin - Document_Changes_Trace.Trace ("Applying changes for document " & URI); - - Self.Version := Version; - - for Change of Vector loop - if Change.a_range.Is_Set then - -- We're replacing a range - - declare - Low_Line : Natural := Change.a_range.Value.start.line; - High_Line : Natural := Change.a_range.Value.an_end.line; - Delete_High : Natural := High_Line; - Start_Index : Natural; - - First_Marker : VSS.Strings.Markers.Character_Marker; - Last_Marker : VSS.Strings.Markers.Character_Marker; - Start_Marker : VSS.Strings.Markers.Character_Marker; - End_Marker : VSS.Strings.Markers.Character_Marker; - - begin - -- Do text replacement - - Self.Span_To_Markers - (Change.a_range.Value, First_Marker, Last_Marker); - Self.Text.Replace (First_Marker, Last_Marker, Change.text); - - -- Markers inside modified range of lines need to be - -- recomputed, markers outside of this range has been - -- recomputed by call to Replace. - - -- Use marker of the line before the first modified line as - -- start marker for recompute because marker of the first - -- modified line may be ether invalidated or moved by Replace, - -- or start from first character of the new text when first - -- line was modified. - - if Low_Line /= Self.Line_To_Marker.First_Index then - Low_Line := Low_Line - 1; - Start_Index := Low_Line; - Start_Marker := Self.Line_To_Marker (Low_Line); - - else - Start_Index := Self.Line_To_Marker.First_Index; - Start_Marker := Self.Text.At_First_Character.Marker; - end if; - - -- Use marker of the line after the last modified line as end - -- marker for recompute because marker of the last modified - -- line may be ether invalidated or moved and not point to the - -- beginning of the line, or use invalid marker when last line - -- was modified. - - if High_Line /= Self.Line_To_Marker.Last_Index then - Delete_High := High_Line; - High_Line := High_Line + 1; - End_Marker := Self.Line_To_Marker (High_Line); - end if; - - if Low_Line = Self.Line_To_Marker.First_Index - and then High_Line = Self.Line_To_Marker.Last_Index - then - Self.Recompute_Indexes; - - else - if Delete_High >= Low_Line then - Self.Line_To_Marker.Delete - (Low_Line, - Ada.Containers.Count_Type - (Delete_High - Low_Line + 1)); - end if; - - Self.Recompute_Markers - (Start_Index, Start_Marker, End_Marker); - end if; - end; - - else - Self.Text := Change.text; - - -- We're setting the whole text: compute the indexes now. - - Self.Recompute_Indexes; - end if; - end loop; - - Document_Changes_Trace.Trace - ("Done applying changes for document " & URI); - end Apply_Changes; - ------------- -- Cleanup -- ------------- @@ -238,75 +99,6 @@ package body LSP.GPR_Documents is end if; end Get_Errors; - ------------------------- - -- Get_Source_Location -- - ------------------------- - - function Get_Source_Location - (Self : Document'Class; - Position : LSP.Structures.Position) - return Langkit_Support.Slocs.Source_Location - is - use type VSS.Unicode.UTF16_Code_Unit_Offset; - use type VSS.Strings.Character_Index; - - Iterator : VSS.Strings.Character_Iterators.Character_Iterator := - Self.Text.At_Character (Self.Line_To_Marker (Position.line)); - - Line_Offset : constant VSS.Unicode.UTF16_Code_Unit_Offset := - Iterator.First_UTF16_Offset; - - Line_First_Character : constant VSS.Strings.Character_Index := - Iterator.Character_Index; - - begin - while Integer (Iterator.First_UTF16_Offset - Line_Offset) - <= Position.character - and then Iterator.Forward - loop - null; - end loop; - - return - ((Line => Langkit_Support.Slocs.Line_Number (Position.line + 1), - Column => Langkit_Support.Slocs.Column_Number - (Iterator.Character_Index - Line_First_Character))); - end Get_Source_Location; - - ----------------- - -- Get_Text_At -- - ----------------- - - function Get_Text_At - (Self : Document; - Start_Pos : LSP.Structures.Position; - End_Pos : LSP.Structures.Position) return VSS.Strings.Virtual_String - is - First_Marker : VSS.Strings.Markers.Character_Marker; - Last_Marker : VSS.Strings.Markers.Character_Marker; - - begin - Self.Span_To_Markers - ((Start_Pos, End_Pos), First_Marker, Last_Marker); - - return Self.Text.Slice (First_Marker, Last_Marker); - end Get_Text_At; - - ----------------- - -- Get_Word_At -- - ----------------- - - function Get_Word_At - (Self : Document; - Position : LSP.Structures.Position) - return VSS.Strings.Virtual_String - is - Result : VSS.Strings.Virtual_String; - - begin - return Result; - end Get_Word_At; - --------------------- -- Has_Diagnostics -- --------------------- @@ -329,37 +121,12 @@ package body LSP.GPR_Documents is Text : VSS.Strings.Virtual_String; Provider : LSP.GPR_Files.File_Provider_Access) is begin - Self.URI := URI; + LSP.Text_Documents.Constructors.Initialize (Self, URI, Text); + Self.File := File; - Self.Version := 1; - Self.Text := Text; Self.File_Provider := Provider; - - Recompute_Indexes (Self); end Initialize; - --------------------- - -- Line_Terminator -- - --------------------- - - function Line_Terminator - (Self : Document'Class) return VSS.Strings.Virtual_String - is - use type VSS.Strings.Virtual_String; - - begin - if Self.Line_Terminator.Is_Empty then - -- Document has no line terminator yet, return LF as most used - -- - -- Should it be platform specific? CRLF for Windows, CR for Mac? - - return 1 * VSS.Characters.Latin.Line_Feed; - - else - return Self.Line_Terminator; - end if; - end Line_Terminator; - ---------- -- Load -- ---------- @@ -411,143 +178,6 @@ package body LSP.GPR_Documents is end Load; - ----------------------- - -- Recompute_Indexes -- - ----------------------- - - procedure Recompute_Indexes (Self : in out Document) is - use type VSS.Strings.Character_Count; - - begin - Self.Line_To_Marker.Clear; - - -- To avoid too many reallocations during the initial filling - -- of the index vector, pre-allocate it. Give a generous - -- pre-allocation assuming that there is a line break every - -- 20 characters on average (this file has one line break - -- every 33 characters). - Self.Line_To_Marker.Reserve_Capacity - (Ada.Containers.Count_Type (Self.Text.Character_Length / 20)); - - declare - J : VSS.Strings.Line_Iterators.Line_Iterator := - Self.Text.At_First_Line - (Terminators => LSP_New_Line_Function_Set, - Keep_Terminator => True); - Last_Line_Terminated : Boolean := False; - - begin - if J.Has_Element then - -- Update Line_Terminator of the document - Self.Line_Terminator := Self.Text.Slice - (J.Terminator_First_Marker, J.Terminator_Last_Marker); - - loop - Self.Line_To_Marker.Append (J.First_Marker); - Last_Line_Terminated := J.Has_Line_Terminator; - - exit when not J.Forward; - end loop; - - else - Last_Line_Terminated := True; - -- Force to add one line for an empty document. - end if; - - -- Append marker at the end of the text when the last line has line - -- terminator sequence or text is empty. It allows to avoid checks - -- for corner cases. - - if Last_Line_Terminated then - Self.Line_To_Marker.Append (J.First_Marker); - end if; - end; - end Recompute_Indexes; - - ----------------------- - -- Recompute_Markers -- - ----------------------- - - procedure Recompute_Markers - (Self : in out Document'Class; - Low_Line : Natural; - Start_Marker : VSS.Strings.Markers.Character_Marker; - End_Marker : VSS.Strings.Markers.Character_Marker) - is - use type VSS.Strings.Character_Count; - - M : VSS.Strings.Markers.Character_Marker; - J : VSS.Strings.Line_Iterators.Line_Iterator := - Self.Text.At_Line - (Position => Start_Marker, - Terminators => LSP_New_Line_Function_Set, - Keep_Terminator => True); - Line : Natural := Low_Line; - - begin - if J.Has_Element then - loop - M := J.First_Marker; - - exit - when End_Marker.Is_Valid - and then M.Character_Index = End_Marker.Character_Index; - - Self.Line_To_Marker.Insert (Line, M); - Line := Line + 1; - - exit when not J.Forward; - end loop; - - if not End_Marker.Is_Valid then - Self.Line_To_Marker.Append (J.First_Marker); - end if; - end if; - end Recompute_Markers; - - --------------------- - -- Span_To_Markers -- - --------------------- - - procedure Span_To_Markers - (Self : Document'Class; - Span : LSP.Structures.A_Range; - From : out VSS.Strings.Markers.Character_Marker; - To : out VSS.Strings.Markers.Character_Marker) - is - use type VSS.Unicode.UTF16_Code_Unit_Offset; - - J1 : VSS.Strings.Character_Iterators.Character_Iterator := - Self.Text.At_Character (Self.Line_To_Marker (Span.start.line)); - U1 : constant VSS.Unicode.UTF16_Code_Unit_Offset := - J1.First_UTF16_Offset; - - J2 : VSS.Strings.Character_Iterators.Character_Iterator := - Self.Text.At_Character (Self.Line_To_Marker (Span.an_end.line)); - U2 : constant VSS.Unicode.UTF16_Code_Unit_Offset := - J2.First_UTF16_Offset; - - Dummy : Boolean; - - begin - while Span.start.character /= Integer (J1.First_UTF16_Offset - U1) - and then J1.Forward - loop - null; - end loop; - - From := J1.Marker; - - while Span.an_end.character /= Integer (J2.First_UTF16_Offset - U2) - and then J2.Forward - loop - null; - end loop; - - Dummy := J2.Backward; - To := J2.Marker; - end Span_To_Markers; - ----------------------------- -- Update_Files_With_Diags -- ----------------------------- @@ -558,15 +188,4 @@ package body LSP.GPR_Documents is Self.Published_Files_With_Diags := Files; end Update_Files_With_Diags; - -------------------------- - -- Versioned_Identifier -- - -------------------------- - - function Versioned_Identifier - (Self : Document) return LSP.Structures.VersionedTextDocumentIdentifier is - begin - return (uri => Self.URI, - version => Self.Version); - end Versioned_Identifier; - end LSP.GPR_Documents; diff --git a/source/gpr/lsp-gpr_documents.ads b/source/gpr/lsp-gpr_documents.ads index c9b82fc79..5bd81a27f 100644 --- a/source/gpr/lsp-gpr_documents.ads +++ b/source/gpr/lsp-gpr_documents.ads @@ -32,17 +32,17 @@ with GPR2.Path_Name; with GPR2.Path_Name.Set; with GPR2.Project.Tree; +with LSP.Text_Documents; with LSP.GPR_Files; with LSP.Structures; with LSP.Tracers; with VSS.Strings; -private with VSS.Strings.Markers; package LSP.GPR_Documents is type Document (Tracer : not null LSP.Tracers.Tracer_Access) is - tagged limited private; + new LSP.Text_Documents.Text_Document with private; -- A GPR document (file). type Document_Access is access all LSP.GPR_Documents.Document @@ -75,31 +75,6 @@ package LSP.GPR_Documents is procedure Cleanup (Self : in out Document); -- Free all the data associated to this document. - ----------------------- - -- Contents handling -- - ----------------------- - - function URI (Self : Document) return LSP.Structures.DocumentUri; - -- Return the URI associated with Self - - function Text (Self : Document) return VSS.Strings.Virtual_String; - -- Return the text associated with Self - - function Get_Text_At - (Self : Document; - Start_Pos : LSP.Structures.Position; - End_Pos : LSP.Structures.Position) return VSS.Strings.Virtual_String; - -- Return the text in the specified range. - - procedure Apply_Changes - (Self : aliased in out Document; - Version : Integer; - Vector : LSP.Structures.TextDocumentContentChangeEvent_Vector); - -- Modify document according to event vector provided by LSP client. - - function Versioned_Identifier - (Self : Document) return LSP.Structures.VersionedTextDocumentIdentifier; - -------------- -- Requests -- -------------- @@ -118,12 +93,6 @@ package LSP.GPR_Documents is return Boolean; -- Returns True when errors found during document parsing. - function Get_Word_At - (Self : Document; - Position : LSP.Structures.Position) - return VSS.Strings.Virtual_String; - -- Get an identifier at given position in the document or an empty string. - ----------------------- -- Document_Provider -- ----------------------- @@ -156,26 +125,11 @@ package LSP.GPR_Documents is -- If the document is not opened, then it returns a -- VersionedTextDocumentIdentifier with a null version. - function Get_Source_Location - (Self : Document'Class; - Position : LSP.Structures.Position) - return Langkit_Support.Slocs.Source_Location; - -- Convert a Position to a Source_Location - - function Line_Terminator - (Self : Document'Class) return VSS.Strings.Virtual_String; - -- Return line terminator for the document - procedure Update_Files_With_Diags (Self : in out Document'Class; Files : GPR2.Path_Name.Set.Object); private - package Line_Marker_Vectors is new Ada.Containers.Vectors - (Index_Type => Natural, - Element_Type => VSS.Strings.Markers.Character_Marker, - "=" => VSS.Strings.Markers."="); - type Name_Information is record Loc : Langkit_Support.Slocs.Source_Location; Is_Public : Boolean; @@ -190,21 +144,11 @@ private "<" => VSS.Strings."<", "=" => Name_Vectors."="); - type Document - (Tracer : not null LSP.Tracers.Tracer_Access) is tagged limited record - - URI : LSP.Structures.DocumentUri; - -- document's file URI - + type Document (Tracer : not null LSP.Tracers.Tracer_Access) is + new LSP.Text_Documents.Text_Document with record File : GPR2.Path_Name.Object; -- document's file path - Version : Integer := 1; - -- Document version - - Text : VSS.Strings.Virtual_String; - -- The text of the document - Tree : GPR2.Project.Tree.Object; -- The loaded tree @@ -226,25 +170,9 @@ private Errors_Changed : Boolean; -- True if Messages content was not yet published - Line_To_Marker : Line_Marker_Vectors.Vector; - -- Within text, an array associating a line number (starting at 0) to - -- the marker of the first character of that line in Text. - -- This serves as cache to be able to modify text ranges in Text - -- given in line/column coordinates without having to scan the whole - -- text from the beginning. - - Line_Terminator : VSS.Strings.Virtual_String; - -- Line terminator for the text, if known, "" otherwise - Published_Files_With_Diags : GPR2.Path_Name.Set.Object; -- Protocol requires publishing empty diags to clear diags on client. -- This set records files with diags previously published. - end record; - function URI (Self : Document) return LSP.Structures.DocumentUri is - (Self.URI); - function Text (Self : Document) return VSS.Strings.Virtual_String is - (Self.Text); - end LSP.GPR_Documents; diff --git a/source/gpr/lsp-gpr_handlers.adb b/source/gpr/lsp-gpr_handlers.adb index b1c47c098..34cbfd2e0 100644 --- a/source/gpr/lsp-gpr_handlers.adb +++ b/source/gpr/lsp-gpr_handlers.adb @@ -154,11 +154,7 @@ package body LSP.GPR_Handlers is return (URI, (Is_Null => True)); else - return - (uri => Target_Text_Document.Versioned_Identifier.uri, - version => - (Is_Null => False, - Value => Target_Text_Document.Versioned_Identifier.version)); + return Target_Text_Document.Identifier; end if; end Get_Open_Document_Version; diff --git a/source/server/lsp-text_documents-langkit_documents.adb b/source/server/lsp-text_documents-langkit_documents.adb new file mode 100644 index 000000000..2af66a809 --- /dev/null +++ b/source/server/lsp-text_documents-langkit_documents.adb @@ -0,0 +1,152 @@ +------------------------------------------------------------------------------ +-- Language Server Protocol -- +-- -- +-- Copyright (C) 2023, 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 VSS.Strings.Character_Iterators; +with VSS.Unicode; + +package body LSP.Text_Documents.Langkit_Documents is + + function To_LSP_Line + (Line : Langkit_Support.Slocs.Line_Number) return Natural + is (Natural (Line) - 1); + + function Line + (Self : Langkit_Text_Document'Class; + Index : Langkit_Support.Slocs.Line_Number) + return VSS.Strings.Virtual_String; + + ---------- + -- Line -- + ---------- + + function Line + (Self : Langkit_Text_Document'Class; + Index : Langkit_Support.Slocs.Line_Number) + return VSS.Strings.Virtual_String + is + Line : constant Natural := To_LSP_Line (Index); + + begin + if Self.Line_Marker.Last_Index = Line then + return + Self.Text.Slice + (Self.Line_Marker (Line), Self.Text.After_Last_Character); + + else + return + Self.Text.Slice + (Self.Line_Marker (Line), Self.Line_Marker (Line + 1)); + end if; + end Line; + + ---------------- + -- To_A_Range -- + ---------------- + + function To_A_Range + (Self : Langkit_Text_Document'Class; + A_Range : Langkit_Support.Slocs.Source_Location_Range) + return LSP.Structures.A_Range + is + Start_Line : constant Natural := To_LSP_Line (A_Range.Start_Line); + Start_Line_Text : constant VSS.Strings.Virtual_String := + Self.Line (A_Range.Start_Line); + Start_Iterator : VSS.Strings.Character_Iterators.Character_Iterator := + Start_Line_Text.At_First_Character; + + End_Line : constant Natural := Natural (A_Range.End_Line) - 1; + End_Line_Text : constant VSS.Strings.Virtual_String := + Self.Line (A_Range.End_Line); + End_Iterator : VSS.Strings.Character_Iterators.Character_Iterator := + End_Line_Text.At_First_Character; + + Success : Boolean with Unreferenced; + + begin + -- Iterating forward through the line of the start position, initial + -- iterator points to the first characters, thus "starts" from the + -- second one. + + for J in 2 .. A_Range.Start_Column loop + Success := Start_Iterator.Forward; + end loop; + + -- Iterating forward through the line of the end position. For the same + -- reason "starts" from second character. + + for J in 2 .. A_Range.End_Column loop + Success := End_Iterator.Forward; + end loop; + + return + (start => + (line => Start_Line, + character => Natural (Start_Iterator.First_UTF16_Offset)), + an_end => + (line => End_Line, + character => Natural (End_Iterator.Last_UTF16_Offset))); + end To_A_Range; + + ------------------------ + -- To_Source_Location -- + ------------------------ + + function To_Source_Location + (Self : Langkit_Text_Document'Class; + Position : LSP.Structures.Position) + return Langkit_Support.Slocs.Source_Location + is + use type VSS.Strings.Character_Index; + use type VSS.Unicode.UTF16_Code_Unit_Offset; + + Iterator : VSS.Strings.Character_Iterators.Character_Iterator := + Self.Text.At_Character (Self.Line_Marker (Position.line)); + + Line_Offset : constant VSS.Unicode.UTF16_Code_Unit_Offset := + Iterator.First_UTF16_Offset; + Line_First_Character : constant VSS.Strings.Character_Index := + Iterator.Character_Index; + + begin + while Integer (Iterator.First_UTF16_Offset - Line_Offset) + <= Position.character + and then Iterator.Forward + loop + null; + end loop; + + return ((Line => Langkit_Support.Slocs.Line_Number (Position.line + 1), + Column => Langkit_Support.Slocs.Column_Number + (Iterator.Character_Index - Line_First_Character))); + end To_Source_Location; + + ------------------------------ + -- To_Source_Location_Range -- + ------------------------------ + + function To_Source_Location_Range + (Self : Langkit_Text_Document'Class; + A_Range : LSP.Structures.A_Range) + return Langkit_Support.Slocs.Source_Location_Range is + begin + return + Langkit_Support.Slocs.Make_Range + (Self.To_Source_Location (A_Range.start), + Self.To_Source_Location (A_Range.an_end)); + end To_Source_Location_Range; + +end LSP.Text_Documents.Langkit_Documents; diff --git a/source/server/lsp-text_documents-langkit_documents.ads b/source/server/lsp-text_documents-langkit_documents.ads new file mode 100644 index 000000000..c85d6a3d3 --- /dev/null +++ b/source/server/lsp-text_documents-langkit_documents.ads @@ -0,0 +1,57 @@ +------------------------------------------------------------------------------ +-- Language Server Protocol -- +-- -- +-- Copyright (C) 2023, 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 an text document that use Langkit's conventions of +-- indexing characters, positions, and slices (ranges). +-- +-- The indexing conventions in Langkit align with VSS's +-- Line_Index/Character_Index when tabulation expansion in Langkit is turned +-- off (with a tabulation size set to 1). In a similar manner, the indices of +-- ranges (spans, slices) directly correspond to the characters themselves. +-- +-- LSP employs a distinct set of conventions, and it's essential to avoid +-- converting VSS/Langkit indexes and ranges directly through type conversion. + +with Langkit_Support.Slocs; + +package LSP.Text_Documents.Langkit_Documents is + + type Langkit_Text_Document is abstract new Text_Document with private; + + function To_Source_Location + (Self : Langkit_Text_Document'Class; + Position : LSP.Structures.Position) + return Langkit_Support.Slocs.Source_Location; + -- Convert a LSP's Position to a Langkit's Source_Location + + function To_Source_Location_Range + (Self : Langkit_Text_Document'Class; + A_Range : LSP.Structures.A_Range) + return Langkit_Support.Slocs.Source_Location_Range; + -- Convert a LSP's A_Range to a Langkit's Source_Location_Range + + function To_A_Range + (Self : Langkit_Text_Document'Class; + A_Range : Langkit_Support.Slocs.Source_Location_Range) + return LSP.Structures.A_Range; + -- Convert LAL's Source_Location_Range to LSP's A_Range + +private + + type Langkit_Text_Document is abstract new Text_Document with null record; + +end LSP.Text_Documents.Langkit_Documents; diff --git a/source/server/lsp-text_documents.adb b/source/server/lsp-text_documents.adb new file mode 100644 index 000000000..f5fba562e --- /dev/null +++ b/source/server/lsp-text_documents.adb @@ -0,0 +1,950 @@ +------------------------------------------------------------------------------ +-- Language Server Protocol -- +-- -- +-- Copyright (C) 2023, 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 Ada.Unchecked_Deallocation; + +with VSS.Characters.Latin; +with VSS.Strings.Character_Iterators; +with VSS.Strings.Line_Iterators; +with VSS.String_Vectors; +with VSS.Unicode; + +package body LSP.Text_Documents is + + procedure Range_To_Markers + (Self : Text_Document'Class; + Span : LSP.Structures.A_Range; + From : out VSS.Strings.Markers.Character_Marker; + To : out VSS.Strings.Markers.Character_Marker); + + procedure Recompute_Indexes (Self : in out Text_Document'Class); + -- Recompute the line-to-offset indexes in Self + + procedure Recompute_Markers + (Self : in out Text_Document'Class; + Low_Line : Natural; + Start_Marker : VSS.Strings.Markers.Character_Marker; + End_Marker : VSS.Strings.Markers.Character_Marker); + -- Recompute line-to-marker index starting from Start_Marker till + -- End_Marker and filling index table starting at Low_Line. End_Marker + -- may be invalid marker, in this case indexing down to the end of the + -- text. + + ------------------- + -- Apply_Changes -- + ------------------- + + procedure Apply_Changes + (Self : in out Text_Document'Class; + Version : Integer; + Vector : LSP.Structures.TextDocumentContentChangeEvent_Vector) is + begin + Self.Version := Version; + + for Change of Vector loop + if Change.a_range.Is_Set then + -- We're replacing a range + + declare + Low_Line : Natural := Change.a_range.Value.start.line; + High_Line : Natural := Change.a_range.Value.an_end.line; + Delete_High : Natural := High_Line; + Start_Index : Natural; + + First_Marker : VSS.Strings.Markers.Character_Marker; + Last_Marker : VSS.Strings.Markers.Character_Marker; + Start_Marker : VSS.Strings.Markers.Character_Marker; + End_Marker : VSS.Strings.Markers.Character_Marker; + + begin + -- Do text replacement + + Self.Range_To_Markers + (Change.a_range.Value, First_Marker, Last_Marker); + Self.Text.Replace (First_Marker, Last_Marker, Change.text); + + -- Markers inside modified range of lines need to be + -- recomputed, markers outside of this range has been + -- recomputed by call to Replace. + + -- Use marker of the line before the first modified line as + -- start marker for recompute because marker of the first + -- modified line may be ether invalidated or moved by Replace, + -- or start from first character of the new text when first + -- line was modified. + + if Low_Line /= Self.Line_Marker.First_Index then + Low_Line := Low_Line - 1; + Start_Index := Low_Line; + Start_Marker := Self.Line_Marker (Low_Line); + + else + Start_Index := Self.Line_Marker.First_Index; + Start_Marker := Self.Text.At_First_Character.Marker; + end if; + + -- Use marker of the line after the last modified line as end + -- marker for recompute because marker of the last modified + -- line may be ether invalidated or moved and not point to the + -- beginning of the line, or use invalid marker when last line + -- was modified. + + if High_Line /= Self.Line_Marker.Last_Index then + Delete_High := High_Line; + High_Line := High_Line + 1; + End_Marker := Self.Line_Marker (High_Line); + end if; + + if Low_Line = Self.Line_Marker.First_Index + and then High_Line = Self.Line_Marker.Last_Index + then + Self.Recompute_Indexes; + + else + if Delete_High >= Low_Line then + Self.Line_Marker.Delete + (Low_Line, + Ada.Containers.Count_Type + (Delete_High - Low_Line + 1)); + end if; + + Self.Recompute_Markers + (Start_Index, Start_Marker, End_Marker); + end if; + end; + + else + Self.Text := Change.text; + + -- We're setting the whole text: compute the indexes now. + Self.Recompute_Indexes; + end if; + end loop; + end Apply_Changes; + + ------------------ + -- Constructors -- + ------------------ + + package body Constructors is + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize + (Self : in out Text_Document'Class; + URI : LSP.Structures.DocumentUri; + Text : VSS.Strings.Virtual_String) is + begin + Self.URI := URI; + Self.Text := Text; + + Self.Recompute_Indexes; + end Initialize; + + end Constructors; + + ---------- + -- Diff -- + ---------- + + procedure Diff + (Self : Text_Document'Class; + New_Text : VSS.Strings.Virtual_String; + Old_Span : LSP.Structures.A_Range := Empty_Range; + New_Span : LSP.Structures.A_Range := Empty_Range; + Edit : out LSP.Structures.TextEdit_Vector) + is + use type LSP.Structures.A_Range; + use type LSP.Structures.Position; + + Old_First_Line : Natural; + New_First_Line : Natural; + + Old_Lines, New_Lines : VSS.String_Vectors.Virtual_String_Vector; + Old_Length, New_Length : Natural; + + begin + Old_Lines := + Self.Text.Split_Lines + (Terminators => LSP_New_Line_Function_Set, + Keep_Terminator => True); + New_Lines := + New_Text.Split_Lines + (Terminators => LSP_New_Line_Function_Set, + Keep_Terminator => True); + + if Old_Span = Empty_Range then + Old_First_Line := 1; + Old_Length := Old_Lines.Length; + + else + Old_First_Line := Natural (Old_Span.start.line + 1); + Old_Length := + Natural (Old_Span.an_end.line - Old_Span.start.line + 1); + end if; + + if New_Span = Empty_Range then + New_First_Line := 1; + New_Length := New_Lines.Length; + else + New_First_Line := Natural (New_Span.start.line + 1); + New_Length := + Natural (New_Span.an_end.line - New_Span.start.line + 1); + end if; + + declare + use type VSS.Strings.Virtual_String; + + type LCS_Array is array + (Natural range 0 .. Old_Length, + Natural range 0 .. New_Length) of Integer; + type LCS_Array_Access is access all LCS_Array; + + procedure Free is + new Ada.Unchecked_Deallocation (LCS_Array, LCS_Array_Access); + + LCS : LCS_Array_Access := new LCS_Array; + Match : Integer; + Delete : Integer; + Insert : Integer; + + Old_Index : Natural := Old_Length; + New_Index : Natural := New_Length; + + Old_Natural : Natural; + -- needed to determine which line number in the old buffer is + -- changed, deleted or before which new lines are inserted + + Changed_Block_Text : VSS.Strings.Virtual_String; + Changed_Block_Span : LSP.Structures.A_Range := ((0, 0), (0, 0)); + + procedure Prepare + (Line : Natural; + Text : VSS.Strings.Virtual_String); + -- Store imformation for Text_Etid in New_String and Span + + procedure Add (From_Line : Natural); + -- Add prepared New_String and Span into Text_Edit + + ------------- + -- Prepare -- + ------------- + + procedure Prepare + (Line : Natural; + Text : VSS.Strings.Virtual_String) is + begin + if Changed_Block_Span.an_end = (0, 0) then + -- it is the first portion of a changed block so store + -- last position of the changes + Changed_Block_Span.an_end := (Line, 0); + end if; + + -- accumulating new text for the changed block + Changed_Block_Text.Prepend (Text); + end Prepare; + + --------- + -- Add -- + --------- + + procedure Add (From_Line : Natural) is + begin + if Changed_Block_Span.an_end = (0, 0) then + -- No information for Text_Edit + return; + end if; + + Changed_Block_Span.start := + (line => From_Line, + character => 0); + + Edit.Prepend + (LSP.Structures.TextEdit' + (a_range => Changed_Block_Span, + newText => Changed_Block_Text)); + + -- clearing + Changed_Block_Text.Clear; + Changed_Block_Span := ((0, 0), (0, 0)); + end Add; + + begin + -- prepare LCS + + -- default values for line 0 + + for Index in 0 .. Old_Length loop + LCS (Index, 0) := -5 * Index; + end loop; + + -- default values for the first column + + for Index in 0 .. New_Length loop + LCS (0, Index) := -5 * Index; + end loop; + + -- calculate LCS + + for Row in 1 .. Old_Length loop + for Column in 1 .. New_Length loop + Match := LCS (Row - 1, Column - 1) + + (if Old_Lines (Old_First_Line + Row - 1) = + New_Lines (New_First_Line + Column - 1) + then 10 -- +10 is the 'weight' for equal lines + else -1); -- and -1 for the different + + Delete := LCS (Row - 1, Column) - 5; + Insert := LCS (Row, Column - 1) - 5; + + LCS (Row, Column) := Integer'Max (Match, Insert); + LCS (Row, Column) := Integer'Max (LCS (Row, Column), Delete); + end loop; + end loop; + + -- iterate over LCS and create Text_Edit + + Old_Natural := Natural (Old_First_Line + Old_Length - 1); + + while Old_Index > 0 + and then New_Index > 0 + loop + if LCS (Old_Index, New_Index) = + LCS (Old_Index - 1, New_Index - 1) + + (if Old_Lines (Old_First_Line + Old_Index - 1) = + New_Lines (New_First_Line + New_Index - 1) + then 10 + else -1) + then + -- both has lines + + if New_Lines.Element (New_First_Line + New_Index - 1) = + Old_Lines.Element (Old_First_Line + Old_Index - 1) + then + -- lines are equal, add Text_Edit after current line + -- if any is already prepared + Add (Old_Natural); + else + -- lines are different, change old line by new one, + -- we deleted whole line so 'To' position will be + -- the beginning of the next line + Prepare + (Old_Natural, + New_Lines.Element (New_First_Line + New_Index - 1)); + end if; + + -- move lines cursor backward + Old_Natural := Old_Natural - 1; + + New_Index := New_Index - 1; + Old_Index := Old_Index - 1; + + elsif LCS (Old_Index, New_Index) = + LCS (Old_Index - 1, New_Index) - 5 + then + -- line has been deleted, move lines cursor backward + + Prepare (Old_Natural, VSS.Strings.Empty_Virtual_String); + + Old_Natural := Old_Natural - 1; + Old_Index := Old_Index - 1; + + elsif LCS (Old_Index, New_Index) = + LCS (Old_Index, New_Index - 1) - 5 + then + -- line has been inserted + -- insert Text_Edit information with insertion after + -- current line, do not move lines cursor because it is + -- additional line not present in the old document + Prepare + (Old_Natural, + New_Lines.Element (New_First_Line + New_Index - 1)); + + New_Index := New_Index - 1; + end if; + end loop; + + while Old_Index > 0 loop + -- deleted + + Prepare (Old_Natural, VSS.Strings.Empty_Virtual_String); + + Old_Natural := Old_Natural - 1; + Old_Index := Old_Index - 1; + end loop; + + while New_Index > 0 loop + -- inserted + + Prepare + (Old_Natural, + New_Lines.Element (New_First_Line + New_Index - 1)); + + New_Index := New_Index - 1; + end loop; + + Add (Old_Natural); + Free (LCS); + + -- Handle the edge case where the last location of + -- the edit is trying to affect a non existent line. + -- The edits are ordered so we only need to check the last one. + + if not Edit.Is_Empty + and then not Self.Line_Marker.Is_Empty + and then Edit.Last_Element.a_range.an_end.line not in + Self.Line_Marker.First_Index .. Self.Line_Marker.Last_Index + then + declare + Element : LSP.Structures.TextEdit := Edit.Last_Element; + Last_Line : constant VSS.Strings.Virtual_String := + Old_Lines (Old_Lines.Length); + Iterator : + constant VSS.Strings.Character_Iterators.Character_Iterator := + Last_Line.At_Last_Character; + + begin + -- Replace the wrong location by the end of the buffer + + Element.a_range.an_end := + (line => Old_Lines.Length - 1, + character => Natural (Iterator.Last_UTF16_Offset) + 1); + Edit.Replace_Element (Edit.Last, Element); + end; + end if; + + exception + when others => + Free (LCS); + raise; + end; + end Diff; + + ------------------ + -- Diff_Symbols -- + ------------------ + + procedure Diff_Symbols + (Self : Text_Document'Class; + Span : LSP.Structures.A_Range; + New_Text : VSS.Strings.Virtual_String; + Edit : in out LSP.Structures.TextEdit_Vector) + is + use VSS.Strings; + use VSS.Characters; + + Old_Text : VSS.Strings.Virtual_String; + Old_Lines : VSS.String_Vectors.Virtual_String_Vector; + Old_Line : VSS.Strings.Virtual_String; + Old_Length, New_Length : Natural; + + First_Marker : VSS.Strings.Markers.Character_Marker; + Last_Marker : VSS.Strings.Markers.Character_Marker; + + begin + Self.Range_To_Markers (Span, First_Marker, Last_Marker); + + Old_Text := Self.Text.Slice (First_Marker, Last_Marker); + Old_Lines := Old_Text.Split_Lines + (Terminators => LSP_New_Line_Function_Set, + Keep_Terminator => True); + Old_Line := Old_Lines.Element (Old_Lines.Length); + + Old_Length := Integer (Character_Length (Old_Text)); + New_Length := Integer (Character_Length (New_Text)); + + declare + type LCS_Array is array + (Natural range 0 .. Old_Length, + Natural range 0 .. New_Length) of Integer; + type LCS_Array_Access is access all LCS_Array; + + procedure Free is + new Ada.Unchecked_Deallocation (LCS_Array, LCS_Array_Access); + + LCS : LCS_Array_Access := new LCS_Array; + Match : Integer; + Delete : Integer; + Insert : Integer; + + Old_Char : VSS.Strings.Character_Iterators.Character_Iterator := + Old_Text.At_First_Character; + + New_Char : VSS.Strings.Character_Iterators.Character_Iterator := + New_Text.At_First_Character; + + Dummy : Boolean; + + Old_Index, New_Index : Integer; + + Changed_Block_Text : VSS.Strings.Virtual_String; + Changed_Block_Span : LSP.Structures.A_Range := ((0, 0), (0, 0)); + Span_Set : Boolean := False; + + -- to calculate span + Current_Natural : Natural := + (if Span.an_end.character = 0 + then Span.an_end.line - 1 + else Span.an_end.line); + -- we do not have a line at all when the range end is on the + -- begin of a line, so set Current_Natural to the previous one + Old_Lines_Number : Natural := Old_Lines.Length; + + Cursor : VSS.Strings.Character_Iterators.Character_Iterator := + Old_Line.After_Last_Character; + + procedure Backward; + -- Move old line Cursor backward, update Old_Line and + -- Old_Lines_Number if needed + + function Get_Position + (Insert : Boolean) return LSP.Structures.Position; + -- get Position for a Span based on Cursor to prepare first/last + -- position for changes + + procedure Prepare_Last_Span (Insert : Boolean); + -- Store position based on Cursor to Changed_Block_Span.an_end if + -- it is not stored yet + + procedure Prepare_Change + (Insert : Boolean; + Char : VSS.Characters.Virtual_Character); + -- Collect change information for Text_Edit in Changed_Block_Text + -- and Changed_Block_Span + + procedure Add_Prepared_Change; + -- Add prepared New_String and corresponding Span into Text_Edit + + -------------- + -- Backward -- + -------------- + + procedure Backward is + begin + if not Cursor.Backward + and then Old_Lines_Number > 1 + then + Current_Natural := Current_Natural - 1; + Old_Lines_Number := Old_Lines_Number - 1; + Old_Line := Old_Lines.Element (Old_Lines_Number); + Cursor.Set_At_Last (Old_Line); + end if; + + Old_Index := Old_Index - 1; + Dummy := Old_Char.Backward; + end Backward; + + ------------------ + -- Get_Position -- + ------------------ + + function Get_Position + (Insert : Boolean) return LSP.Structures.Position + is + -------------- + -- Backward -- + -------------- + + function Backward return LSP.Structures.Position; + + function Backward return LSP.Structures.Position is + C : VSS.Strings.Character_Iterators.Character_Iterator := + Old_Line.At_Character (Cursor); + begin + -- "Cursor" is after the current character but we should + -- insert before it + if C.Backward then + return + (line => Current_Natural, + character => Natural (C.First_UTF16_Offset)); + else + return + (line => Current_Natural, + character => 0); + end if; + end Backward; + + begin + if not Cursor.Has_Element then + return + (line => Current_Natural, + character => 0); + + elsif Insert then + -- "Cursor" is after the current character but we should + -- insert before it + return Backward; + + else + return + (line => Current_Natural, + character => Natural (Cursor.First_UTF16_Offset)); + end if; + end Get_Position; + + ----------------------- + -- Prepare_Last_Span -- + ----------------------- + + procedure Prepare_Last_Span (Insert : Boolean) is + begin + if not Span_Set then + -- it is the first portion of a changed block so store + -- last position of the changes + Span_Set := True; + Changed_Block_Span.an_end := Get_Position (Insert); + end if; + end Prepare_Last_Span; + + -------------------- + -- Prepare_Change -- + -------------------- + + procedure Prepare_Change + (Insert : Boolean; + Char : VSS.Characters.Virtual_Character) is + begin + Prepare_Last_Span (Insert); + -- accumulating new text for the changed block + Changed_Block_Text.Prepend (Char); + end Prepare_Change; + + ------------------------- + -- Add_Prepared_Change -- + ------------------------- + + procedure Add_Prepared_Change is + begin + if not Span_Set then + -- No information for Text_Edit + return; + end if; + + Changed_Block_Span.start := Get_Position (False); + + Edit.Prepend + (LSP.Structures.TextEdit' + (a_range => Changed_Block_Span, + newText => Changed_Block_Text)); + + -- clearing + Changed_Block_Text.Clear; + + Changed_Block_Span := ((0, 0), (0, 0)); + Span_Set := False; + end Add_Prepared_Change; + + begin + -- prepare LCS + + -- default values for line 0 + for Index in 0 .. Old_Length loop + LCS (Index, 0) := -5 * Index; + end loop; + + -- default values for the first column + for Index in 0 .. New_Length loop + LCS (0, Index) := -5 * Index; + end loop; + + -- calculate LCS + for Row in 1 .. Old_Length loop + New_Char.Set_At_First (New_Text); + for Column in 1 .. New_Length loop + Match := LCS (Row - 1, Column - 1) + + (if Old_Char.Element = New_Char.Element + then 10 -- +10 is the 'weight' for equal lines + else -1); -- and -1 for the different + + Delete := LCS (Row - 1, Column) - 5; + Insert := LCS (Row, Column - 1) - 5; + + LCS (Row, Column) := Integer'Max (Match, Insert); + LCS (Row, Column) := Integer'Max (LCS (Row, Column), Delete); + + Dummy := New_Char.Forward; + end loop; + Dummy := Old_Char.Forward; + end loop; + + -- iterate over LCS and create Text_Edit + + Old_Char.Set_At_Last (Old_Text); + New_Char.Set_At_Last (New_Text); + Old_Index := Old_Length; + New_Index := New_Length; + + while Old_Index > 0 + and then New_Index > 0 + loop + if LCS (Old_Index, New_Index) = + LCS (Old_Index - 1, New_Index - 1) + + (if Old_Char.Element = New_Char.Element + then 10 + else -1) + then + -- both has elements + if Old_Char.Element = New_Char.Element then + -- elements are equal, add prepared Text_Edit + Add_Prepared_Change; + else + -- elements are different, change old one by new + Prepare_Change (False, New_Char.Element); + end if; + + -- move old element cursors backward + Backward; + + New_Index := New_Index - 1; + Dummy := New_Char.Backward; + + elsif LCS (Old_Index, New_Index) = + LCS (Old_Index - 1, New_Index) - 5 + then + -- element has been deleted, move old cursor backward + Prepare_Last_Span (False); + Backward; + + elsif LCS (Old_Index, New_Index) = + LCS (Old_Index, New_Index - 1) - 5 + then + -- element has been inserted + Prepare_Change (True, New_Char.Element); + + New_Index := New_Index - 1; + Dummy := New_Char.Backward; + end if; + end loop; + + while Old_Index > 0 loop + -- deleted + Prepare_Last_Span (False); + Backward; + end loop; + + while New_Index > 0 loop + -- inserted + Prepare_Change (True, New_Char.Element); + + New_Index := New_Index - 1; + Dummy := New_Char.Backward; + end loop; + + Add_Prepared_Change; + Free (LCS); + + exception + when others => + Free (LCS); + raise; + end; + end Diff_Symbols; + + ---------------- + -- Identifier -- + ---------------- + + function Identifier + (Self : Text_Document'Class) + return LSP.Structures.OptionalVersionedTextDocumentIdentifier is + begin + return (uri => Self.URI, + version => + (Is_Null => False, + Value => Self.Version)); + end Identifier; + + --------------------- + -- Line_Terminator -- + --------------------- + + function Line_Terminator + (Self : Text_Document'Class) return VSS.Strings.Virtual_String + is + use type VSS.Strings.Virtual_String; + + begin + return + (if Self.Line_Terminator.Is_Empty then + -- Document has no line terminator yet, return LF as most used + -- + -- Should it be platform specific? CRLF for Windows, CR for Mac? + + 1 * VSS.Characters.Latin.Line_Feed + + else + Self.Line_Terminator); + end Line_Terminator; + + ---------------------- + -- Range_To_Markers -- + ---------------------- + + procedure Range_To_Markers + (Self : Text_Document'Class; + Span : LSP.Structures.A_Range; + From : out VSS.Strings.Markers.Character_Marker; + To : out VSS.Strings.Markers.Character_Marker) + is + use type VSS.Unicode.UTF16_Code_Unit_Offset; + + J1 : VSS.Strings.Character_Iterators.Character_Iterator := + Self.Text.At_Character (Self.Line_Marker (Span.start.line)); + U1 : constant VSS.Unicode.UTF16_Code_Unit_Offset := + J1.First_UTF16_Offset; + + J2 : VSS.Strings.Character_Iterators.Character_Iterator := + Self.Text.At_Character (Self.Line_Marker (Span.an_end.line)); + U2 : constant VSS.Unicode.UTF16_Code_Unit_Offset := + J2.First_UTF16_Offset; + + Dummy : Boolean; + + begin + while Span.start.character /= Integer (J1.First_UTF16_Offset - U1) + and then J1.Forward + loop + null; + end loop; + + From := J1.Marker; + + while Span.an_end.character /= Integer (J2.First_UTF16_Offset - U2) + and then J2.Forward + loop + null; + end loop; + + Dummy := J2.Backward; + To := J2.Marker; + end Range_To_Markers; + + ----------------------- + -- Recompute_Indexes -- + ----------------------- + + procedure Recompute_Indexes (Self : in out Text_Document'Class) is + use type VSS.Strings.Character_Count; + + begin + Self.Line_Marker.Clear; + + -- To avoid too many reallocations during the initial filling + -- of the index vector, pre-allocate it. Give a generous + -- pre-allocation assuming that there is a line break every + -- 20 characters on average (this file has one line break + -- every 33 characters). + Self.Line_Marker.Reserve_Capacity + (Ada.Containers.Count_Type (Self.Text.Character_Length / 20)); + + declare + J : VSS.Strings.Line_Iterators.Line_Iterator := + Self.Text.At_First_Line + (Terminators => LSP_New_Line_Function_Set, + Keep_Terminator => True); + Last_Line_Terminated : Boolean := False; + + begin + if J.Has_Element then + -- Update Line_Terminator of the document + + Self.Line_Terminator := Self.Text.Slice + (J.Terminator_First_Marker, J.Terminator_Last_Marker); + + loop + Self.Line_Marker.Append (J.First_Marker); + Last_Line_Terminated := J.Has_Line_Terminator; + + exit when not J.Forward; + end loop; + + else + Last_Line_Terminated := True; + -- Force to add one line for an empty document. + end if; + + -- Append marker at the end of the text when the last line has line + -- terminator sequence or text is empty. It allows to avoid checks + -- for corner cases. + + if Last_Line_Terminated then + Self.Line_Marker.Append (J.First_Marker); + end if; + end; + end Recompute_Indexes; + + ----------------------- + -- Recompute_Markers -- + ----------------------- + + procedure Recompute_Markers + (Self : in out Text_Document'Class; + Low_Line : Natural; + Start_Marker : VSS.Strings.Markers.Character_Marker; + End_Marker : VSS.Strings.Markers.Character_Marker) + is + use type VSS.Strings.Character_Count; + + M : VSS.Strings.Markers.Character_Marker; + J : VSS.Strings.Line_Iterators.Line_Iterator := + Self.Text.At_Line + (Position => Start_Marker, + Terminators => LSP_New_Line_Function_Set, + Keep_Terminator => True); + Line : Natural := Low_Line; + + begin + if J.Has_Element then + loop + M := J.First_Marker; + + exit + when End_Marker.Is_Valid + and then M.Character_Index = End_Marker.Character_Index; + + Self.Line_Marker.Insert (Line, M); + Line := Line + 1; + + exit when not J.Forward; + end loop; + + if not End_Marker.Is_Valid then + Self.Line_Marker.Append (J.First_Marker); + end if; + end if; + end Recompute_Markers; + + ----------- + -- Slice -- + ----------- + + function Slice + (Self : Text_Document'Class; + A_Range : LSP.Structures.A_Range) return VSS.Strings.Virtual_String + is + First_Marker : VSS.Strings.Markers.Character_Marker; + Last_Marker : VSS.Strings.Markers.Character_Marker; + + begin + Self.Range_To_Markers (A_Range, First_Marker, Last_Marker); + + return Self.Text.Slice (First_Marker, Last_Marker); + end Slice; + +end LSP.Text_Documents; diff --git a/source/server/lsp-text_documents.ads b/source/server/lsp-text_documents.ads new file mode 100644 index 000000000..2a0dca809 --- /dev/null +++ b/source/server/lsp-text_documents.ads @@ -0,0 +1,140 @@ +------------------------------------------------------------------------------ +-- Language Server Protocol -- +-- -- +-- Copyright (C) 2023, 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 an text document abstraction. It provides capability +-- to apply and generate text edits. + +private with Ada.Containers.Vectors; + +with VSS.Strings; +private with VSS.Strings.Markers; + +with LSP.Structures; + +package LSP.Text_Documents is + + LSP_New_Line_Function_Set : constant VSS.Strings.Line_Terminator_Set := + (VSS.Strings.CR | VSS.Strings.CRLF | VSS.Strings.LF => True, + others => False); + -- LSP allows to use three kinds of line terminators: CR, CR+LF and LF. + + Empty_Range : LSP.Structures.A_Range := ((1, 1), (0, 0)); + + type Text_Position is record + Line : VSS.Strings.Line_Index; + Column : VSS.Strings.Line_Index'Base; + end record; + + type Text_Slice is record + First : Text_Position; + Last : Text_Position; + end record; + + type Text_Document is abstract tagged limited private; + + function URI (Self : Text_Document'Class) return LSP.Structures.DocumentUri; + -- Return the URI associated with Self + + function Identifier + (Self : Text_Document'Class) + return LSP.Structures.OptionalVersionedTextDocumentIdentifier; + + function Text + (Self : Text_Document'Class) return VSS.Strings.Virtual_String; + + function Slice + (Self : Text_Document'Class; + A_Range : LSP.Structures.A_Range) return VSS.Strings.Virtual_String; + -- Return the text in the specified range. + + function Line_Terminator + (Self : Text_Document'Class) return VSS.Strings.Virtual_String; + -- Return line terminator for the document + + procedure Apply_Changes + (Self : in out Text_Document'Class; + Version : Integer; + Vector : LSP.Structures.TextDocumentContentChangeEvent_Vector); + -- Modify document according to event vector provided by LSP client. + + procedure Diff + (Self : Text_Document'Class; + New_Text : VSS.Strings.Virtual_String; + Old_Span : LSP.Structures.A_Range := Empty_Range; + New_Span : LSP.Structures.A_Range := Empty_Range; + Edit : out LSP.Structures.TextEdit_Vector); + -- Create a diff between document Text and New_Text and return Text_Edit + -- based on Needleman-Wunsch algorithm. + -- Old_Span and New_Span are used when we need to compare certain + -- old/new lines instead of whole buffers. + + procedure Diff_Symbols + (Self : Text_Document'Class; + Span : LSP.Structures.A_Range; + New_Text : VSS.Strings.Virtual_String; + Edit : in out LSP.Structures.TextEdit_Vector); + -- Create a diff between document Text inside Span and New_Chunk and + -- return Text_Edit. Tests individual symbols instead of lines + -- as above. Do not use it for large text slices because it + -- creates an N^M map for symbols. + + package Constructors is + + procedure Initialize + (Self : in out Text_Document'Class; + URI : LSP.Structures.DocumentUri; + Text : VSS.Strings.Virtual_String); + + end Constructors; + +private + + package Line_Marker_Vectors is new Ada.Containers.Vectors + (Index_Type => Natural, + Element_Type => VSS.Strings.Markers.Character_Marker, + "=" => VSS.Strings.Markers."="); + + type Text_Document is abstract tagged limited record + URI : LSP.Structures.DocumentUri; + -- URI of the document + + Version : Integer := 1; + -- Document version + + Text : VSS.Strings.Virtual_String; + -- The text of the document + + Line_Terminator : VSS.Strings.Virtual_String; + -- Line terminator for the text, if known, "" otherwise + + Line_Marker : Line_Marker_Vectors.Vector; + -- Within text, an array associating a line number (starting at 0) to + -- the marker of the first character of that line in Text. + -- This serves as cache to be able to modify text ranges in Text + -- given in line/column coordinates without having to scan the whole + -- text from the beginning. + end record; + + function Text + (Self : Text_Document'Class) return VSS.Strings.Virtual_String is + (Self.Text); + + function URI + (Self : Text_Document'Class) return LSP.Structures.DocumentUri is + (Self.URI); + +end LSP.Text_Documents;