Skip to content

Commit 32b5faf

Browse files
reznikmmreznikmm
committed
Merge branch 'topic/ooe' into 'master'
Add Job_Scheduler to LSP server. See merge request eng/ide/ada_language_server!1489
2 parents 8141f7e + 082435b commit 32b5faf

31 files changed

+1776
-501
lines changed

‎source/ada/lsp-ada_configurations.ads

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ with LSP.Structures;
2626

2727
package LSP.Ada_Configurations is
2828

29-
type Configuration is tagged limited private;
29+
type Configuration is tagged private;
3030

3131
procedure Read_JSON
3232
(Self : in out Configuration'Class;
@@ -116,7 +116,7 @@ private
116116

117117
use type VSS.Strings.Virtual_String;
118118

119-
type Configuration is tagged limited record
119+
type Configuration is tagged record
120120
Project_File : VSS.Strings.Virtual_String;
121121
Charset : VSS.Strings.Virtual_String;
122122
Relocate_Build_Tree : VSS.Strings.Virtual_String;

‎source/ada/lsp-ada_did_change_configurations.adb

Lines changed: 100 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,100 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 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 LSP.Ada_Configurations;
19+
with LSP.Client_Message_Receivers;
20+
with LSP.Server_Notifications.DidChangeConfiguration;
21+
22+
package body LSP.Ada_Did_Change_Configurations is
23+
24+
type Apply_Config_Job
25+
(Parent : not null access constant Ada_Did_Change_Handler)
26+
is limited new LSP.Server_Jobs.Server_Job with record
27+
Message : LSP.Server_Messages.Server_Message_Access;
28+
Configuration : LSP.Ada_Configurations.Configuration;
29+
Reload : Boolean;
30+
Is_Done : Boolean := False;
31+
end record;
32+
33+
type Apply_Config_Job_Access is access all Apply_Config_Job;
34+
35+
overriding function Priority
36+
(Self : Apply_Config_Job) return LSP.Server_Jobs.Job_Priority is
37+
(LSP.Server_Jobs.Fence);
38+
39+
overriding function Is_Done (Self : Apply_Config_Job) return Boolean is
40+
(Self.Is_Done);
41+
42+
overriding procedure Execute
43+
(Self : in out Apply_Config_Job;
44+
Client :
45+
in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class);
46+
47+
overriding function Message (Self : Apply_Config_Job)
48+
return LSP.Server_Messages.Server_Message_Access is (Self.Message);
49+
50+
-------------
51+
-- Execute --
52+
-------------
53+
54+
overriding procedure Execute
55+
(Self : in out Apply_Config_Job;
56+
Client :
57+
in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class) is
58+
begin
59+
Self.Parent.Context.Set_Configuration (Self.Configuration);
60+
61+
if Self.Reload then
62+
Self.Parent.Context.Reload_Project;
63+
end if;
64+
65+
Self.Is_Done := True;
66+
end Execute;
67+
68+
----------------
69+
-- Create_Job --
70+
----------------
71+
72+
overriding function Create_Job
73+
(Self : Ada_Did_Change_Handler;
74+
Message : LSP.Server_Messages.Server_Message_Access)
75+
return LSP.Server_Jobs.Server_Job_Access
76+
is
77+
Value : LSP.Server_Notifications.DidChangeConfiguration.Notification
78+
renames LSP.Server_Notifications.DidChangeConfiguration.Notification
79+
(Message.all);
80+
81+
Result : constant Apply_Config_Job_Access :=
82+
new Apply_Config_Job (Self'Unchecked_Access);
83+
84+
Reload : Boolean renames Result.Reload;
85+
begin
86+
Result.Configuration := Self.Context.Get_Configuration.all;
87+
Result.Configuration.Read_JSON (Value.Params.settings, Reload);
88+
89+
-- Always reload project if Project_Tree isn't ready
90+
Reload := Reload or not Self.Context.Project_Tree_Is_Defined;
91+
92+
if Reload then
93+
-- Stop indexing by changing project stamp
94+
Self.Context.Increment_Project_Timestamp;
95+
end if;
96+
97+
return LSP.Server_Jobs.Server_Job_Access (Result);
98+
end Create_Job;
99+
100+
end LSP.Ada_Did_Change_Configurations;

‎source/ada/lsp-ada_did_change_configurations.ads

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 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 types for didChangeConfiguration
19+
-- notifications.
20+
21+
with LSP.Ada_Job_Contexts;
22+
with LSP.Server_Jobs;
23+
with LSP.Server_Message_Handlers;
24+
with LSP.Server_Messages;
25+
26+
package LSP.Ada_Did_Change_Configurations 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 null record;
32+
33+
overriding function Create_Job
34+
(Self : Ada_Did_Change_Handler;
35+
Message : LSP.Server_Messages.Server_Message_Access)
36+
return LSP.Server_Jobs.Server_Job_Access;
37+
38+
end LSP.Ada_Did_Change_Configurations;

‎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;

0 commit comments

Comments
 (0)