Skip to content

Commit c883006

Browse files
reznikmmreznikmm
committed
Replace On_DidChange_Notification
with a job. Refs #1141
1 parent a3ce8d6 commit c883006

File tree

7 files changed

+283
-46
lines changed

7 files changed

+283
-46
lines changed

‎source/ada/lsp-ada_did_change_document.adb

Lines changed: 179 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,179 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2018-2024, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
18+
with GNATCOLL.VFS;
19+
20+
with LSP.Ada_Documents;
21+
with LSP.Client_Message_Receivers;
22+
with LSP.Structures;
23+
with LSP.Server_Notifications.DidChange;
24+
25+
package body LSP.Ada_Did_Change_Document is
26+
27+
type Did_Change_Job
28+
(Parent : not null access constant Ada_Did_Change_Handler)
29+
is limited new LSP.Server_Jobs.Server_Job with record
30+
Document : LSP.Ada_Documents.Document_Access;
31+
Message : LSP.Server_Messages.Server_Message_Access;
32+
Is_Done : Boolean := False;
33+
end record;
34+
35+
type Did_Change_Job_Access is access all Did_Change_Job;
36+
37+
overriding function Priority
38+
(Self : Did_Change_Job) return LSP.Server_Jobs.Job_Priority is
39+
(LSP.Server_Jobs.Fence);
40+
41+
overriding function Is_Done (Self : Did_Change_Job) return Boolean is
42+
(Self.Is_Done);
43+
44+
overriding procedure Execute
45+
(Self : in out Did_Change_Job;
46+
Client :
47+
in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class);
48+
49+
overriding procedure Complete
50+
(Self : in out Did_Change_Job;
51+
Next : LSP.Server_Messages.Server_Message_Access);
52+
53+
overriding function Message (Self : Did_Change_Job)
54+
return LSP.Server_Messages.Server_Message_Access is (Self.Message);
55+
56+
function Is_Incremental
57+
(Changes : LSP.Structures.TextDocumentContentChangeEvent_Vector)
58+
return Boolean is
59+
(not Changes.Is_Empty and then Changes.First_Element.a_range.Is_Set);
60+
-- Changes has incrimental form (not just full text update)
61+
62+
--------------
63+
-- Complete --
64+
--------------
65+
66+
overriding procedure Complete
67+
(Self : in out Did_Change_Job;
68+
Next : LSP.Server_Messages.Server_Message_Access)
69+
is
70+
use type LSP.Server_Messages.Server_Message_Access;
71+
use type GNATCOLL.VFS.Virtual_File;
72+
73+
Message : LSP.Server_Notifications.DidChange.Notification renames
74+
LSP.Server_Notifications.DidChange.Notification (Self.Message.all);
75+
76+
Changes : LSP.Structures.TextDocumentContentChangeEvent_Vector renames
77+
Message.Params.contentChanges;
78+
79+
File : constant GNATCOLL.VFS.Virtual_File :=
80+
Self.Parent.Context.To_File (Message.Params.textDocument.uri);
81+
82+
begin
83+
if Next /= null and then
84+
Next.all in LSP.Server_Notifications.DidChange.Notification'Class
85+
then
86+
declare
87+
Change : LSP.Server_Notifications.DidChange.Notification renames
88+
LSP.Server_Notifications.DidChange.Notification (Next.all);
89+
90+
Next_File : constant GNATCOLL.VFS.Virtual_File :=
91+
Self.Parent.Context.To_File (Change.Params.textDocument.uri);
92+
begin
93+
if File = Next_File then
94+
-- However, we should skip the Indexing part (and
95+
-- non-incremental changes) if the next didChange message
96+
-- will re-change the text document.
97+
return;
98+
end if;
99+
end;
100+
end if;
101+
102+
if not Is_Incremental (Changes) then
103+
Self.Document.Apply_Changes
104+
(Message.Params.textDocument.version, Changes);
105+
end if;
106+
107+
for Context of Self.Parent.Context.Contexts_For_File (File) loop
108+
Context.Index_Document (Self.Document.all);
109+
end loop;
110+
111+
-- Emit diagnostics
112+
Self.Parent.Context.Publish_Diagnostics (Self.Document);
113+
end Complete;
114+
115+
----------------
116+
-- Create_Job --
117+
----------------
118+
119+
overriding function Create_Job
120+
(Self : Ada_Did_Change_Handler;
121+
Message : LSP.Server_Messages.Server_Message_Access)
122+
return LSP.Server_Jobs.Server_Job_Access
123+
is
124+
Value : LSP.Server_Notifications.DidChange.Notification renames
125+
LSP.Server_Notifications.DidChange.Notification (Message.all);
126+
127+
URI : LSP.Structures.DocumentUri renames
128+
Value.Params.textDocument.uri;
129+
130+
Document : constant LSP.Ada_Documents.Document_Access :=
131+
Self.Context.Get_Open_Document (URI);
132+
133+
Result : constant Did_Change_Job_Access :=
134+
new Did_Change_Job'
135+
(Parent => Self'Unchecked_Access,
136+
Document => Document,
137+
Message => Message,
138+
Is_Done => False);
139+
begin
140+
return LSP.Server_Jobs.Server_Job_Access (Result);
141+
end Create_Job;
142+
143+
-------------
144+
-- Execute --
145+
-------------
146+
147+
overriding procedure Execute
148+
(Self : in out Did_Change_Job;
149+
Client :
150+
in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class)
151+
is
152+
use type LSP.Ada_Documents.Document_Access;
153+
154+
Message : LSP.Server_Notifications.DidChange.Notification renames
155+
LSP.Server_Notifications.DidChange.Notification (Self.Message.all);
156+
157+
Changes : LSP.Structures.TextDocumentContentChangeEvent_Vector renames
158+
Message.Params.contentChanges;
159+
begin
160+
Self.Is_Done := True;
161+
162+
if Self.Document = null then
163+
return;
164+
end if;
165+
166+
if Is_Incremental (Changes) then
167+
-- If we are applying incremental changes, we can't skip the
168+
-- call to Apply_Changes, since this would break synchronization.
169+
Self.Document.Apply_Changes
170+
(Message.Params.textDocument.version, Changes);
171+
172+
-- However, we should skip the Indexing part if the next didChange
173+
-- message will re-change the text document.
174+
end if;
175+
176+
-- Rest of the work in Complete routine
177+
end Execute;
178+
179+
end LSP.Ada_Did_Change_Document;

‎source/ada/lsp-ada_did_change_document.ads

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2018-2024, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
--
18+
-- This package provides handler and job type for didChange notifications.
19+
20+
with LSP.Ada_Job_Contexts;
21+
with LSP.Server_Message_Handlers;
22+
23+
private with LSP.Server_Jobs;
24+
private with LSP.Server_Messages;
25+
26+
package LSP.Ada_Did_Change_Document is
27+
28+
type Ada_Did_Change_Handler
29+
(Context : not null access LSP.Ada_Job_Contexts.Ada_Job_Context'Class) is
30+
limited new LSP.Server_Message_Handlers.Server_Message_Handler
31+
with private;
32+
33+
private
34+
35+
type Ada_Did_Change_Handler
36+
(Context : not null access LSP.Ada_Job_Contexts.Ada_Job_Context'Class) is
37+
limited new LSP.Server_Message_Handlers.Server_Message_Handler
38+
with null record;
39+
40+
overriding function Create_Job
41+
(Self : Ada_Did_Change_Handler;
42+
Message : LSP.Server_Messages.Server_Message_Access)
43+
return LSP.Server_Jobs.Server_Job_Access;
44+
45+
end LSP.Ada_Did_Change_Document;

‎source/ada/lsp-ada_driver.adb

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ with GNATCOLL.Utils;
3939

4040
with LSP.Ada_Commands;
4141
with LSP.Ada_Did_Change_Configurations;
42+
with LSP.Ada_Did_Change_Document;
4243
with LSP.Ada_Handlers;
4344
with LSP.Ada_Handlers.Executables_Commands;
4445
with LSP.Ada_Handlers.Mains_Commands;
@@ -70,6 +71,7 @@ with LSP.GPR_External_Tools;
7071
with LSP.Memory_Statistics;
7172
with LSP.Predefined_Completion;
7273
with LSP.Secure_Message_Loggers;
74+
with LSP.Server_Notifications.DidChange;
7375
with LSP.Server_Notifications.DidChangeConfiguration;
7476
with LSP.Servers;
7577
with LSP.Stdio_Streams;
@@ -173,6 +175,10 @@ procedure LSP.Ada_Driver is
173175
LSP.Ada_Did_Change_Configurations.Ada_Did_Change_Handler
174176
(Ada_Handler'Unchecked_Access);
175177

178+
Ada_Did_Change_Doc_Handler : aliased
179+
LSP.Ada_Did_Change_Document.Ada_Did_Change_Handler
180+
(Ada_Handler'Unchecked_Access);
181+
176182
Fuzzing_Activated : constant Boolean :=
177183
not VSS.Application.System_Environment.Value ("ALS_FUZZING").Is_Empty;
178184
pragma Unreferenced (Fuzzing_Activated);
@@ -369,6 +375,10 @@ begin
369375
(LSP.Server_Notifications.DidChangeConfiguration.Notification'Tag,
370376
Ada_Did_Change_Handler'Unchecked_Access);
371377

378+
Server.Register_Handler
379+
(LSP.Server_Notifications.DidChange.Notification'Tag,
380+
Ada_Did_Change_Doc_Handler'Unchecked_Access);
381+
372382
Server.Run
373383
(Ada_Handler'Unchecked_Access,
374384
Tracer'Unchecked_Access,

‎source/ada/lsp-ada_handlers.adb

Lines changed: 5 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -250,8 +250,8 @@ package body LSP.Ada_Handlers is
250250
-- Contexts_For_File --
251251
-----------------------
252252

253-
function Contexts_For_File
254-
(Self : access Message_Handler;
253+
overriding function Contexts_For_File
254+
(Self : Message_Handler;
255255
File : GNATCOLL.VFS.Virtual_File)
256256
return LSP.Ada_Context_Sets.Context_Lists.List
257257
is
@@ -275,36 +275,6 @@ package body LSP.Ada_Handlers is
275275
return Self.Contexts.Each_Context (Is_A_Source'Unrestricted_Access);
276276
end Contexts_For_File;
277277

278-
----------------------
279-
-- Contexts_For_URI --
280-
----------------------
281-
282-
function Contexts_For_URI
283-
(Self : access Message_Handler;
284-
URI : LSP.Structures.DocumentUri)
285-
return LSP.Ada_Context_Sets.Context_Lists.List
286-
is
287-
function Is_A_Source (Self : LSP.Ada_Contexts.Context) return Boolean is
288-
(Self.Is_Part_Of_Project (URI));
289-
-- Return True if URI is a source of the project held by Context
290-
291-
File : constant GNATCOLL.VFS.Virtual_File := Self.To_File (URI);
292-
begin
293-
-- If the file does not exist on disk, assume this is a file
294-
-- being created and, as a special convenience in this case,
295-
-- assume it could belong to any project.
296-
if not File.Is_Regular_File
297-
-- If the file is a runtime file for the loaded project environment,
298-
-- all projects can see it.
299-
or else Self.Project_Predefined_Sources.Contains (File)
300-
then
301-
return Self.Contexts.Each_Context;
302-
end if;
303-
304-
-- List contexts where File is a source of the project hierarchy
305-
return Self.Contexts.Each_Context (Is_A_Source'Unrestricted_Access);
306-
end Contexts_For_URI;
307-
308278
----------
309279
-- Free --
310280
----------
@@ -321,7 +291,7 @@ package body LSP.Ada_Handlers is
321291
-- Get_Open_Document --
322292
-----------------------
323293

324-
function Get_Open_Document
294+
overriding function Get_Open_Document
325295
(Self : in out Message_Handler;
326296
URI : LSP.Structures.DocumentUri)
327297
return LSP.Ada_Documents.Document_Access
@@ -4641,8 +4611,8 @@ package body LSP.Ada_Handlers is
46414611
-- Publish_Diagnostics --
46424612
-------------------------
46434613

4644-
procedure Publish_Diagnostics
4645-
(Self : in out Message_Handler'Class;
4614+
overriding procedure Publish_Diagnostics
4615+
(Self : in out Message_Handler;
46464616
Document : not null LSP.Ada_Documents.Document_Access;
46474617
Other_Diagnostics : LSP.Structures.Diagnostic_Vector :=
46484618
LSP.Structures.Empty;

‎source/ada/lsp-ada_handlers.ads

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -75,8 +75,8 @@ package LSP.Ada_Handlers is
7575
--
7676
-- Config_File - custom configuration file, if present
7777

78-
function Contexts_For_File
79-
(Self : access Message_Handler;
78+
overriding function Contexts_For_File
79+
(Self : Message_Handler;
8080
File : GNATCOLL.VFS.Virtual_File)
8181
return LSP.Ada_Context_Sets.Context_Lists.List;
8282

@@ -93,7 +93,7 @@ package LSP.Ada_Handlers is
9393
-- Open Document Manager --
9494
-----------------------------
9595

96-
function Get_Open_Document
96+
overriding function Get_Open_Document
9797
(Self : in out Message_Handler;
9898
URI : LSP.Structures.DocumentUri)
9999
return LSP.Ada_Documents.Document_Access;
@@ -439,8 +439,8 @@ private
439439
Id : LSP.Structures.Integer_Or_Virtual_String;
440440
Value : LSP.Structures.WorkspaceSymbolParams);
441441

442-
procedure Publish_Diagnostics
443-
(Self : in out Message_Handler'Class;
442+
overriding procedure Publish_Diagnostics
443+
(Self : in out Message_Handler;
444444
Document : not null LSP.Ada_Documents.Document_Access;
445445
Other_Diagnostics : LSP.Structures.Diagnostic_Vector :=
446446
LSP.Structures.Empty;
@@ -451,8 +451,8 @@ private
451451
-- When Force is True, the diagnostics will always be sent, not matter if
452452
-- they have changed or not.
453453

454-
function To_File
455-
(Self : Message_Handler'Class;
454+
overriding function To_File
455+
(Self : Message_Handler;
456456
URI : LSP.Structures.DocumentUri) return GNATCOLL.VFS.Virtual_File
457457
is
458458
(GNATCOLL.VFS.Create_From_UTF8
@@ -476,9 +476,11 @@ private
476476
-- controls if files that are supposed to be deleted, are renamed instead.
477477

478478
function Contexts_For_URI
479-
(Self : access Message_Handler;
479+
(Self : Message_Handler'Class;
480480
URI : LSP.Structures.DocumentUri)
481-
return LSP.Ada_Context_Sets.Context_Lists.List;
481+
return LSP.Ada_Context_Sets.Context_Lists.List
482+
is
483+
(Self.Contexts_For_File (Self.To_File (URI)));
482484
-- Return a list of contexts that are suitable for the given File/URI:
483485
-- a list of all contexts where the file is known to be part of the
484486
-- project tree, or is a runtime file for this project. If the file

0 commit comments

Comments
 (0)