@@ -21,6 +21,9 @@ with Ada.Strings.UTF_Encoding;
2121
2222with GNAT.Strings ;
2323
24+ with GNATCOLL.Traces ; use GNATCOLL.Traces;
25+ with GNATCOLL.Scripts ; use GNATCOLL.Scripts;
26+ with GNATCOLL.Scripts.Python ; use GNATCOLL.Scripts.Python;
2427with GNATCOLL.VFS ; use GNATCOLL.VFS;
2528
2629with VSS.Strings.Conversions ;
@@ -47,7 +50,6 @@ with Refactoring.UI;
4750with String_Utils ;
4851with Src_Editor_Module ;
4952with VFS_Module ;
50- with GNATCOLL.Traces ; use GNATCOLL.Traces;
5153
5254package body GPS.LSP_Client.Edit_Workspace is
5355
@@ -66,6 +68,37 @@ package body GPS.LSP_Client.Edit_Workspace is
6668 -- Add to Map the contents of Change, converted to fit the needs
6769 -- of editor buffers.
6870
71+ procedure Debug_Print_Changes
72+ (Msg : String;
73+ Changes : Maps.Map);
74+ -- Trace the given edit changes.
75+
76+ function Get_Minimal_Changes
77+ (Kernel : not null access Kernel_Handle_Record'Class;
78+ Editor : GPS.Editors.Editor_Buffer'Class;
79+ Changes : Maps.Map) return Maps.Map;
80+ -- Reduce the given changes to more minimal ones, to allow keeping track of
81+ -- the cursor when applying TextEdits.
82+ --
83+ -- For example:
84+ -- * Original text: "This is some text"
85+ -- * New text: "This is the new text"
86+ --
87+ -- Instead of removing the whole original text and insert the new one, the
88+ -- newly computed changes will be:
89+ --
90+ -- * Delete "some"
91+ -- * Insert "the new"
92+
93+ procedure Get_Diff_Changes
94+ (Kernel : not null access Kernel_Handle_Record'Class;
95+ Original_Span : LSP.Messages.Span;
96+ Old_Text : String;
97+ New_Text : String;
98+ Changes : out Maps.Map);
99+ -- Compute the diff between Old_Text and New_Text using a Python
100+ -- implementation of the Myers diff algorithm.
101+
69102 type Edit_Workspace_Command is new Interactive_Command with
70103 record
71104 Kernel : Kernel_Handle;
@@ -90,13 +123,225 @@ package body GPS.LSP_Client.Edit_Workspace is
90123 Auto_Save : Boolean;
91124 Allow_File_Renaming : Boolean;
92125 Locations_Message_Markup : Unbounded_String;
126+
127+ Compute_Minimal_Edits : Boolean := False;
128+ -- Compute_Minimal_Edits controls whether we'll try to split the
129+ -- given Edits into smaller ones, allowing to preserve the current
130+ -- cursor's position: thus, this should only be used in particular
131+ -- contexts (e.g: formatting). The computation is done through
132+ -- an implementation of the Myers diff algorithm.
93133 end record ;
94134 overriding function Execute
95135 (Command : access Edit_Workspace_Command;
96136 Context : Interactive_Command_Context) return Command_Return_Type;
97137 overriding function Undo
98138 (Command : access Edit_Workspace_Command) return Boolean;
99139
140+ -- -----------------------
141+ -- Get_Minimal_Changes --
142+ -- -----------------------
143+
144+ function Get_Minimal_Changes
145+ (Kernel : not null access Kernel_Handle_Record'Class;
146+ Editor : GPS.Editors.Editor_Buffer'Class;
147+ Changes : Maps.Map) return Maps.Map
148+ is
149+ New_Changes : Maps.Map;
150+ C : Maps.Cursor;
151+ begin
152+ C := Changes.Last;
153+
154+ Trace (Me, " Nb changes: " & Integer'Image (Integer ((Changes.Length))));
155+
156+ while Maps.Has_Element (C) loop
157+ declare
158+ Span : constant LSP.Messages.Span := Maps.Key (C);
159+ From : constant GPS.Editors.Editor_Location'Class :=
160+ GPS.LSP_Client.Utilities.LSP_Position_To_Location
161+ (Editor, Span.first);
162+ To : constant GPS.Editors.Editor_Location'Class :=
163+ GPS.LSP_Client.Utilities.LSP_Position_To_Location
164+ (Editor, Span.last);
165+ Span_Text : constant String :=
166+ Editor.Get_Chars
167+ (From => From,
168+ To => To,
169+ Include_Hidden_Chars => False);
170+ Old_Text : constant String :=
171+ Span_Text (Span_Text'First .. Span_Text'Last - 1 );
172+ New_Text : String renames Maps.Element (C);
173+ begin
174+ Debug_Print_Changes
175+ (Msg => " Original edits:" ,
176+ Changes => Changes);
177+ Get_Diff_Changes
178+ (Kernel => Kernel,
179+ Original_Span => Span,
180+ Old_Text => Old_Text,
181+ New_Text => New_Text,
182+ Changes => New_Changes);
183+ Debug_Print_Changes
184+ (Msg => " New edits:" ,
185+ Changes => New_Changes);
186+ end ;
187+ Maps.Previous (C);
188+ end loop ;
189+
190+ return New_Changes;
191+ end Get_Minimal_Changes ;
192+
193+ -- --------------------
194+ -- Get_Diff_Changes --
195+ -- --------------------
196+
197+ procedure Get_Diff_Changes
198+ (Kernel : not null access Kernel_Handle_Record'Class;
199+ Original_Span : LSP.Messages.Span;
200+ Old_Text : String;
201+ New_Text : String;
202+ Changes : out Maps.Map)
203+ is
204+ use LSP.Types;
205+ use type VSS.Unicode.UTF16_Code_Unit_Count;
206+
207+ Script : constant GNATCOLL.Scripts.Scripting_Language :=
208+ Kernel.Scripts.Lookup_Scripting_Language (Python_Name);
209+ Data : Callback_Data'Class := Create (Script, 2 );
210+
211+ Cur_Delete_Cursor : LSP.Messages.Position := Original_Span.first;
212+ Next_Delete_Cursor : LSP.Messages.Position := Original_Span.first;
213+ -- The buffer cursors that get updated each time we receive Delete/Keep
214+ -- diff operations. This corresponds to characters being consumed in the
215+ -- original state of the buffer after each diff operation, but without
216+ -- modifying the actual buffer contents.
217+
218+ Cur_Insert_Cursor : LSP.Messages.Position := Original_Span.first;
219+ Next_Insert_Cursor : LSP.Messages.Position := Original_Span.first;
220+ -- The buffer cursors that get updated each time we receive an
221+ -- Insert/Keep diff operations. This corresponds to the buffer's cursor
222+ -- as if we were applying each diff operation sequentially, with the
223+ -- actual modifications to the buffer contents being peformed.
224+
225+ type Diff_Operation_Type is (Keep, Insert, Delete);
226+ -- The type of diff operation.
227+
228+ function Print_Cursor
229+ (Cursor : LSP.Messages.Position;
230+ Name : String) return String
231+ is
232+ (Name
233+ & " ("
234+ & Cursor.line'Img
235+ & " , "
236+ & Cursor.character'Img
237+ & " )"
238+ & ASCII.LF);
239+
240+ function Compute_New_Cursor
241+ (Cursor : LSP.Messages.Position;
242+ Str : String) return LSP.Messages.Position;
243+ -- Compute the the cursor's position according to the current diff
244+ -- operation.
245+
246+ -- ---------------------
247+ -- To_Diff_Operation --
248+ -- ---------------------
249+
250+ function To_Diff_Operation (Num : Integer) return Diff_Operation_Type
251+ is
252+ (case Num is
253+ when -1 => Delete,
254+ when 0 => Keep,
255+ when 1 => Insert,
256+ when others => raise Constraint_Error);
257+
258+ -- ----------------------
259+ -- Compute_New_Cursor --
260+ -- ----------------------
261+
262+ function Compute_New_Cursor
263+ (Cursor : LSP.Messages.Position;
264+ Str : String) return LSP.Messages.Position
265+ is
266+ New_Cursor : LSP.Messages.Position := Cursor;
267+ begin
268+ -- Iterate over the string that we are deleting/inserting/keeping
269+ -- to update the buffer's cursor new position..
270+
271+ for J in Str'Range loop
272+ -- If we are deleting/inserting/keeping a newline, make sure to
273+ -- take it into account by going to the next line.
274+ -- Otherwise, just forward the character offset.
275+ if Str (J) = ASCII.LF then
276+ New_Cursor.line := New_Cursor.line + 1 ;
277+ New_Cursor.character := 0 ;
278+ else
279+ New_Cursor.character := New_Cursor.character + 1 ;
280+ end if ;
281+ end loop ;
282+
283+ return New_Cursor;
284+ end Compute_New_Cursor ;
285+
286+ begin
287+ -- Call the Myers diff Python implementation
288+ Set_Nth_Arg (Data, 1 , Old_Text);
289+ Set_Nth_Arg (Data, 2 , New_Text);
290+ Execute_Command (Data, " diff_match_patch.compute_diff" );
291+
292+ -- Iterate over the results and create the new edit changes.
293+ declare
294+ Result : constant List_Instance'Class := Return_Value (Data);
295+ begin
296+ for J in 1 .. Number_Of_Arguments (Result) loop
297+ declare
298+ Item : constant List_Instance'Class :=
299+ Result.Nth_Arg (J);
300+ Operation : constant Diff_Operation_Type :=
301+ To_Diff_Operation (Item.Nth_Arg (1 ));
302+ Str : constant String := Item.Nth_Arg (2 );
303+ begin
304+ case Operation is
305+ when Keep =>
306+ Next_Delete_Cursor :=
307+ Compute_New_Cursor (Cur_Delete_Cursor, Str);
308+ Next_Insert_Cursor :=
309+ Compute_New_Cursor (Cur_Insert_Cursor, Str);
310+
311+ when Delete =>
312+ Next_Delete_Cursor :=
313+ Compute_New_Cursor (Cur_Delete_Cursor, Str);
314+ Changes.Insert
315+ (Key => (first => Cur_Delete_Cursor,
316+ last => Next_Delete_Cursor),
317+ New_Item => " " );
318+
319+ when Insert =>
320+ Next_Insert_Cursor :=
321+ Compute_New_Cursor (Cur_Insert_Cursor, Str);
322+ Changes.Insert
323+ (Key => (first => Cur_Insert_Cursor,
324+ last => Cur_Insert_Cursor),
325+ New_Item => Str);
326+ end case ;
327+
328+ Trace
329+ (Me,
330+ " ===" & ASCII.LF
331+ & Operation'Img & " : '" & Str & " '" & ASCII.LF
332+ & Print_Cursor (Cur_Insert_Cursor, " Cur_Insert" )
333+ & Print_Cursor (Next_Insert_Cursor, " Next_Insert" )
334+ & Print_Cursor (Cur_Delete_Cursor, " Cur_Delete" )
335+ & Print_Cursor (Next_Delete_Cursor, " Next_Delete" )
336+ & " ===" & ASCII.LF);
337+
338+ Cur_Delete_Cursor := Next_Delete_Cursor;
339+ Cur_Insert_Cursor := Next_Insert_Cursor;
340+ end ;
341+ end loop ;
342+ end ;
343+ end Get_Diff_Changes ;
344+
100345 -- -----------------
101346 -- Insert_Change --
102347 -- -----------------
@@ -131,12 +376,55 @@ package body GPS.LSP_Client.Edit_Workspace is
131376
132377 begin
133378 if Left.first.line = Right.first.line then
134- return Left.first.character < Right.first.character;
379+ if Left.first.character = Right.first.character then
380+ if Left.last.line = Right.last.line then
381+ return Left.last.character < Right.last.character;
382+ else
383+ return Left.last.line < Right.last.line;
384+ end if ;
385+ else
386+ return Left.first.character < Right.first.character;
387+ end if ;
135388 else
136389 return Left.first.line < Right.first.line;
137390 end if ;
138391 end " <" ;
139392
393+ -- -----------------------
394+ -- Debug_Print_Changes --
395+ -- -----------------------
396+
397+ procedure Debug_Print_Changes
398+ (Msg : String;
399+ Changes : Maps.Map)
400+ is
401+ C : Maps.Cursor;
402+ begin
403+ Trace (Me, Msg);
404+ C := Changes.Last;
405+
406+ while Maps.Has_Element (C) loop
407+ declare
408+ Span : constant LSP.Messages.Span := Maps.Key (C);
409+ New_Text : constant String := Maps.Element (C);
410+ begin
411+ Trace
412+ (Me,
413+ ((if New_Text = " " then " * Delete " else " * Insert " )
414+ & " from ("
415+ & Span.first.line'Img
416+ & " ,"
417+ & Span.first.character'Img
418+ & " ) to ("
419+ & Span.last.line'Img
420+ & " ,"
421+ & Span.last.character'Img
422+ & " ) new text:" & New_Text));
423+ Maps.Previous (C);
424+ end ;
425+ end loop ;
426+ end Debug_Print_Changes ;
427+
140428 -- -----------
141429 -- Execute --
142430 -- -----------
@@ -145,8 +433,9 @@ package body GPS.LSP_Client.Edit_Workspace is
145433 (Command : access Edit_Workspace_Command;
146434 Context : Interactive_Command_Context) return Command_Return_Type
147435 is
436+ Kernel : Kernel_Handle renames Command.Kernel;
148437 Buffer_Factory : constant Editor_Buffer_Factory_Access :=
149- Get_Buffer_Factory (Command. Kernel);
438+ Get_Buffer_Factory (Kernel);
150439
151440 Error : Boolean := False;
152441 Errors : Refactoring.UI.Source_File_Set;
@@ -254,6 +543,10 @@ package body GPS.LSP_Client.Edit_Workspace is
254543 Ignored : GPS.Kernel.Messages.Markup.Markup_Message_Access;
255544 URI : constant LSP.Messages.DocumentUri :=
256545 GPS.LSP_Client.Utilities.To_URI (File);
546+ Changes : constant Maps.Map :=
547+ (if Command.Compute_Minimal_Edits then
548+ Get_Minimal_Changes (Kernel, Editor, Map)
549+ else Map);
257550 begin
258551 if Command.Make_Writable
259552 and then Editor.Is_Read_Only
@@ -266,7 +559,7 @@ package body GPS.LSP_Client.Edit_Workspace is
266559 -- Sort changes for applying them in reverse direction
267560 -- from the last to the first line
268561
269- C := Map .Last;
562+ C := Changes .Last;
270563 while Maps.Has_Element (C) loop
271564 declare
272565 use type Visible_Column_Type;
@@ -736,8 +1029,9 @@ package body GPS.LSP_Client.Edit_Workspace is
7361029 Auto_Save : Boolean;
7371030 Allow_File_Renaming : Boolean;
7381031 Locations_Message_Markup : String;
1032+ Error : out Boolean;
7391033 Limit_Span : LSP.Messages.Span := LSP.Messages.Empty_Span;
740- Error : out Boolean )
1034+ Compute_Minimal_Edits : Boolean := False )
7411035 is
7421036 Command : Command_Access := new Edit_Workspace_Command'
7431037 (Root_Command with
@@ -752,7 +1046,8 @@ package body GPS.LSP_Client.Edit_Workspace is
7521046 Auto_Save => Auto_Save,
7531047 Allow_File_Renaming => Allow_File_Renaming,
7541048 Locations_Message_Markup =>
755- To_Unbounded_String (Locations_Message_Markup));
1049+ To_Unbounded_String (Locations_Message_Markup),
1050+ Compute_Minimal_Edits => Compute_Minimal_Edits);
7561051
7571052 begin
7581053 Src_Editor_Module.Set_Global_Command (Command);
0 commit comments