Skip to content

Commit 0850267

Browse files
committed
Add als-other-file command
Refs #669
1 parent e344352 commit 0850267

File tree

5 files changed

+204
-3
lines changed

5 files changed

+204
-3
lines changed

doc/README.md

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -40,8 +40,9 @@ This section includes related feature description documents and links to others
4040
related resources.
4141

4242
## List of features
43-
* [Reference kinds](reference_kinds.md)
44-
4543
* [Called by](called_by.md)
46-
4744
* [Calls](calls.md)
45+
* [Debug](debug.md)
46+
* [Other File](other_file.md)
47+
* [Reference kinds](reference_kinds.md)
48+
* [Show Dependencies](show_dependencies.md)

doc/other_file.md

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
# Other file
2+
3+
## Short introduction
4+
5+
New command to switch between specification and body documents.
6+
7+
## Change description
8+
9+
We introduce a new command (`als-other-file`). It takes `TextDocumentIdentifier`
10+
as parameter and returns nothing. On execution it finds other Ada file and
11+
issues `ShowDocument` request to the client.
12+
13+
VS Code extension wraps this with another parameter-less command `ada.otherFile`.
14+
It checks if an active editor exists and triggers the LSP `als-other-file` command.

source/ada/lsp-ada_driver.adb

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,7 @@ with GNATCOLL.VFS; use GNATCOLL.VFS;
3434

3535
with LSP.Ada_Handlers;
3636
with LSP.Ada_Handlers.Named_Parameters_Commands;
37+
with LSP.Ada_Handlers.Other_File_Commands;
3738
with LSP.Ada_Handlers.Refactor_Imports_Commands;
3839
with LSP.Ada_Handlers.Refactor_Remove_Parameter;
3940
with LSP.Ada_Handlers.Refactor_Move_Parameter;
@@ -128,6 +129,8 @@ procedure LSP.Ada_Driver is
128129

129130
procedure Register_Commands is
130131
begin
132+
LSP.Commands.Register
133+
(LSP.Ada_Handlers.Other_File_Commands.Command'Tag);
131134
LSP.Commands.Register
132135
(LSP.Ada_Handlers.Named_Parameters_Commands.Command'Tag);
133136
LSP.Commands.Register
Lines changed: 123 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2021, 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 Ada.Strings.UTF_Encoding;
19+
20+
with LSP.Messages.Client_Requests;
21+
22+
with VSS.Strings.Conversions;
23+
24+
package body LSP.Ada_Handlers.Other_File_Commands is
25+
26+
------------
27+
-- Create --
28+
------------
29+
30+
overriding function Create
31+
(JS : not null access LSP.JSON_Streams.JSON_Stream'Class) return Command
32+
is
33+
begin
34+
return V : Command do
35+
pragma Assert (JS.R.Is_Start_Object);
36+
JS.R.Read_Next;
37+
38+
while not JS.R.Is_End_Object loop
39+
pragma Assert (JS.R.Is_Key_Name);
40+
declare
41+
Key : constant Ada.Strings.UTF_Encoding.UTF_8_String :=
42+
VSS.Strings.Conversions.To_UTF_8_String (JS.R.Key_Name);
43+
begin
44+
JS.R.Read_Next;
45+
46+
if Key = "uri" then
47+
LSP.Types.Read (JS, V.URI);
48+
else
49+
JS.Skip_Value;
50+
end if;
51+
end;
52+
end loop;
53+
JS.R.Read_Next;
54+
end return;
55+
end Create;
56+
57+
-------------
58+
-- Execute --
59+
-------------
60+
61+
overriding procedure Execute
62+
(Self : Command;
63+
Handler : not null access LSP.Server_Notification_Receivers
64+
.Server_Notification_Receiver'
65+
Class;
66+
Client : not null access LSP.Client_Message_Receivers
67+
.Client_Message_Receiver'
68+
Class;
69+
Error : in out LSP.Errors.Optional_ResponseError)
70+
is
71+
Message_Handler : LSP.Ada_Handlers.Message_Handler renames
72+
LSP.Ada_Handlers.Message_Handler (Handler.all);
73+
74+
Context : LSP.Ada_Contexts.Context renames
75+
Message_Handler.Contexts.Get_Best_Context (Self.URI).all;
76+
77+
File : constant GNATCOLL.VFS.Virtual_File := Context.To_File (Self.URI);
78+
79+
Other_File : constant GNATCOLL.VFS.Virtual_File :=
80+
Message_Handler.Project_Tree.Other_File (File);
81+
82+
URI : constant LSP.Messages.DocumentUri :=
83+
LSP.Ada_Contexts.File_To_URI
84+
(LSP.Types.To_LSP_String (Other_File.Display_Full_Name));
85+
86+
Message : constant LSP.Messages.Client_Requests.ShowDocument_Request :=
87+
(params =>
88+
(uri => URI,
89+
takeFocus => LSP.Types.True,
90+
others => <>),
91+
others => <>);
92+
begin
93+
Client.On_ShowDocument_Request (Message);
94+
end Execute;
95+
96+
----------------
97+
-- Initialize --
98+
----------------
99+
100+
procedure Initialize
101+
(Self : in out Command'Class; URI : LSP.Messages.DocumentUri)
102+
is
103+
begin
104+
Self.URI := URI;
105+
end Initialize;
106+
107+
-------------------
108+
-- Write_Command --
109+
-------------------
110+
111+
procedure Write_Command
112+
(S : access Ada.Streams.Root_Stream_Type'Class; V : Command)
113+
is
114+
JS : LSP.JSON_Streams.JSON_Stream'Class renames
115+
LSP.JSON_Streams.JSON_Stream'Class (S.all);
116+
begin
117+
JS.Start_Object;
118+
JS.Key ("uri");
119+
LSP.Types.Write (S, V.URI);
120+
JS.End_Object;
121+
end Write_Command;
122+
123+
end LSP.Ada_Handlers.Other_File_Commands;
Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2021, 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+
-- Implementation of the command to switch from .adb to .ads file and back.
19+
20+
with Ada.Streams;
21+
22+
with LSP.Client_Message_Receivers;
23+
with LSP.Commands;
24+
with LSP.Errors;
25+
with LSP.JSON_Streams;
26+
27+
package LSP.Ada_Handlers.Other_File_Commands is
28+
29+
type Command is new LSP.Commands.Command with private;
30+
31+
procedure Initialize
32+
(Self : in out Command'Class;
33+
URI : LSP.Messages.DocumentUri);
34+
35+
private
36+
37+
type Command is new LSP.Commands.Command with record
38+
URI : LSP.Messages.DocumentUri;
39+
end record;
40+
41+
overriding function Create
42+
(JS : not null access LSP.JSON_Streams.JSON_Stream'Class)
43+
return Command;
44+
45+
overriding procedure Execute
46+
(Self : Command;
47+
Handler : not null access
48+
LSP.Server_Notification_Receivers.Server_Notification_Receiver'Class;
49+
Client : not null access
50+
LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
51+
Error : in out LSP.Errors.Optional_ResponseError);
52+
53+
procedure Write_Command
54+
(S : access Ada.Streams.Root_Stream_Type'Class;
55+
V : Command);
56+
57+
for Command'Write use Write_Command;
58+
for Command'External_Tag use "als-other-file";
59+
60+
end LSP.Ada_Handlers.Other_File_Commands;

0 commit comments

Comments
 (0)