ada/ada_language_server
0
0
Fork 0
mirror of https://github.com/AdaCore/ada_language_server.git synced 2026-02-12 12:45:50 -08:00
Code Issues Packages Projects Releases Wiki Activity
Files
master
ada_language_server/source/server/lsp-text_documents.adb
Boulanger ef2ea12f81 Handle deletion only from xdiff 
Add a test

Delete extra test-loc.xml

Depends-On: eng/ide/xdiff!9

For eng/ide/ada_language_server#1768
2026-01-30 09:58:35 +00:00

1136 lines
36 KiB
Ada
Raw Permalink Blame History

------------------------------------------------------------------------------
-- Language Server Protocol --
-- --
-- Copyright (C) 2023-2025, 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.Conversions;
with VSS.Strings.Line_Iterators;
with VSS.String_Vectors;
with VSS.Unicode;
with XDiff;
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_Markers.First_Index then
Low_Line := Low_Line - 1;
Start_Index := Low_Line;
Start_Marker := Self.Line_Markers (Low_Line);
else
Start_Index := Self.Line_Markers.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_Markers.Last_Index then
Delete_High := High_Line;
High_Line := High_Line + 1;
End_Marker := Self.Line_Markers (High_Line);
end if;
if Low_Line = Self.Line_Markers.First_Index
and then High_Line = Self.Line_Markers.Last_Index
then
Self.Recompute_Indexes;
else
if Delete_High >= Low_Line then
Self.Line_Markers.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;
Version : Integer) is
begin
Self.URI := URI;
Self.Text := Text;
Self.Version := Version;
Self.Recompute_Indexes;
end Initialize;
end Constructors;
------------
-- Diff_C --
------------
procedure Diff_C
(Self : Text_Document'Class;
New_Text : VSS.Strings.Virtual_String;
Span : LSP.Structures.A_Range;
Edit : out LSP.Structures.TextEdit_Vector)
is
use type LSP.Structures.A_Range;
C_Edit : constant XDiff.Edits := XDiff.XDiff
(VSS.Strings.Conversions.To_UTF_8_String
(if Span /= LSP.Text_Documents.Empty_Range
then Self.Slice (Span)
else Self.Text),
VSS.Strings.Conversions.To_UTF_8_String (New_Text),
XDiff.XDF_NEED_MINIMAL);
New_Lines : constant VSS.String_Vectors.Virtual_String_Vector :=
New_Text.Split_Lines
(Terminators => LSP_New_Line_Function_Set,
Keep_Terminator => False);
Cur : XDiff.Edits := XDiff.First_Edit (C_Edit);
function Get_Range
(Cur_Edit : XDiff.Edits) return LSP.Structures.A_Range;
function Get_Slice
(Lines : VSS.String_Vectors.Virtual_String_Vector;
Start_Line : Integer;
End_Line : Integer)
return VSS.Strings.Virtual_String;
---------------
-- Get_Range --
---------------
function Get_Range (Cur_Edit : XDiff.Edits) return LSP.Structures.A_Range
is
Start_Line : Natural;
End_Line : Natural;
-- Start_Bloc indicates the offset between the current line and the
-- first from the buffer
Start_Bloc : constant Natural :=
(if Span /= LSP.Text_Documents.Empty_Range
then Span.start.line
else 0);
begin
if XDiff.Delete_Line_Start (Cur_Edit) = -1 then
Start_Line := XDiff.Delete_Line_End (Cur_Edit);
else
Start_Line := XDiff.Delete_Line_Start (Cur_Edit) - 1;
end if;
End_Line := XDiff.Delete_Line_End (Cur_Edit);
return (start => (Start_Line + Start_Bloc, 0),
an_end => (End_Line + Start_Bloc, 0));
end Get_Range;
---------------
-- Get_Slice --
---------------
function Get_Slice
(Lines : VSS.String_Vectors.Virtual_String_Vector;
Start_Line : Integer;
End_Line : Integer)
return VSS.Strings.Virtual_String
is
use VSS.Strings;
Res : VSS.Strings.Virtual_String := VSS.Strings.Empty_Virtual_String;
begin
-- If Start_Line is -1 then we are only deleting and not inserting
-- anything.
if Start_Line > -1 then
for I in Start_Line .. End_Line loop
Res.Append (Lines (I) & VSS.Characters.Latin.Line_Feed);
end loop;
end if;
return Res;
end Get_Slice;
begin
if not XDiff.Is_Empty (Cur) then
loop
Edit.Append
(LSP.Structures.TextEdit'
(a_range => Get_Range (Cur),
newText =>
Get_Slice
(New_Lines,
XDiff.Insert_Line_Start (Cur),
XDiff.Insert_Line_End (Cur))));
exit when not XDiff.Has_Next (Cur);
Cur := XDiff.Next_Edit (Cur);
end loop;
end if;
XDiff.Free_Edits (C_Edit);
end Diff_C;
--------------------
-- Needleman_Diff --
--------------------
procedure Needleman_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;
type Virtual_String_Array is
array (Positive range <>) of VSS.Strings.Virtual_String;
type Virtual_String_Array_Access is access all Virtual_String_Array;
procedure Free is
new Ada.Unchecked_Deallocation
(Virtual_String_Array, Virtual_String_Array_Access);
Old_Lines, New_Lines : Virtual_String_Array_Access;
Old_Length, New_Length : Natural;
begin
-- Populate arrays of old and new content.
--
-- As of 20250720, `Virtual_String_Vector`.`Element` takes a lot of time
-- to construct object to return and to finalize object after check of
-- lines equality. Standard `Ada.Containers.Vectors.Element` works a bit
-- faster, however, use of arrays speed up execution many times.
declare
Aux_Old_Lines : VSS.String_Vectors.Virtual_String_Vector;
Aux_New_Lines : VSS.String_Vectors.Virtual_String_Vector;
begin
Aux_Old_Lines :=
Self.Text.Split_Lines
(Terminators => LSP_New_Line_Function_Set,
Keep_Terminator => True);
Old_Lines := new Virtual_String_Array (1 .. Aux_Old_Lines.Length);
for J in Old_Lines'Range loop
Old_Lines (J) := Aux_Old_Lines (J);
end loop;
Aux_New_Lines :=
New_Text.Split_Lines
(Terminators => LSP_New_Line_Function_Set,
Keep_Terminator => True);
New_Lines := new Virtual_String_Array (1 .. Aux_New_Lines.Length);
for J in New_Lines'Range loop
New_Lines (J) := Aux_New_Lines (J);
end loop;
end;
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 (New_First_Line + New_Index - 1) =
Old_Lines (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 (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 (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 (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_Markers.Is_Empty
and then Edit.Last_Element.a_range.an_end.line not in
Self.Line_Markers.First_Index .. Self.Line_Markers.Last_Index
then
declare
Element : LSP.Structures.TextEdit := Edit.Last_Element;
Last_Line : constant VSS.Strings.Virtual_String :=
Old_Lines (Old_Lines'Last);
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;
Free (Old_Lines);
Free (New_Lines);
exception
when others =>
Free (LCS);
Free (Old_Lines);
Free (New_Lines);
raise;
end;
end Needleman_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;
----------------
-- Line_Count --
----------------
function Line_Count (Self : Text_Document'Class) return Natural is
begin
return Natural (Self.Line_Markers.Length);
end Line_Count;
----------------------
-- 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_Markers (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_Markers (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_Markers.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_Markers.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_Markers.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_Markers.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_Markers.Insert (Line, M);
Line := Line + 1;
exit when not J.Forward;
end loop;
if not End_Marker.Is_Valid then
Self.Line_Markers.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;
--------------
-- Get_Line --
--------------
function Get_Line
(Self : Text_Document'Class; Line : Natural)
return VSS.Strings.Virtual_String is
begin
if Line < Self.Line_Markers.First_Index
or else Line > Self.Line_Markers.Last_Index
then
raise Constraint_Error with "Line index out of bounds in Get_Line";
end if;
declare
J : constant VSS.Strings.Line_Iterators.Line_Iterator :=
Self.Text.At_Line
(Position => Self.Line_Markers (Line),
Terminators => LSP_New_Line_Function_Set,
Keep_Terminator => True);
begin
if J.Has_Element then
return J.Element;
else
return VSS.Strings.Empty_Virtual_String;
end if;
end;
end Get_Line;
end LSP.Text_Documents;
Reference in New Issue View Git Blame Copy Permalink