1
1
-- ----------------------------------------------------------------------------
2
2
-- Language Server Protocol --
3
3
-- --
4
- -- Copyright (C) 2023-2024, AdaCore --
4
+ -- Copyright (C) 2023-2024, AdaCore --
5
5
-- --
6
6
-- This is free software; you can redistribute it and/or modify it under --
7
7
-- terms of the GNU General Public License as published by the Free Soft- --
17
17
18
18
with Ada.Characters.Conversions ;
19
19
with Ada.Characters.Latin_1 ;
20
+ with Ada.Characters.Wide_Wide_Latin_1 ;
21
+
20
22
with GPR2.Project.Attribute ;
23
+ with GPR2.Project.Typ ;
21
24
with GPR2.Project.Variable ;
25
+ with GPR2.Source_Reference ;
22
26
23
27
with Gpr_Parser.Common ;
28
+ with Gpr_Parser_Support.Slocs ;
24
29
25
30
with GPR2.Project.Registry.Attribute.Description ;
26
31
with GPR2.Project.Registry.Pack.Description ;
@@ -32,12 +37,119 @@ with VSS.Strings.Conversions;
32
37
33
38
package body LSP.GPR_Documentation is
34
39
40
+ function Get_Documentation
41
+ (Ref : Gpr_Parser.Common.Token_Reference;
42
+ Style : GNATdoc.Comments.Options.Documentation_Style)
43
+ return VSS.Strings.Virtual_String;
44
+ -- Get variable/type declaration comment.
45
+
46
+ -- ---------------------
47
+ -- Get_Documentation --
48
+ -- ---------------------
49
+
50
+ function Get_Documentation
51
+ (Ref : Gpr_Parser.Common.Token_Reference;
52
+ Style : GNATdoc.Comments.Options.Documentation_Style)
53
+ return VSS.Strings.Virtual_String
54
+ is
55
+ Documentation : VSS.Strings.Virtual_String;
56
+ Add_LF : Boolean := False;
57
+ package Slocs renames Gpr_Parser_Support.Slocs;
58
+ use type Slocs.Line_Number;
59
+
60
+ Line : Slocs.Line_Number := Ref.Data.Sloc_Range.Start_Line;
61
+ Token : Gpr_Parser.Common.Token_Reference := Ref;
62
+
63
+ use type GNATdoc.Comments.Options.Documentation_Style;
64
+
65
+ function Next return Gpr_Parser.Common.Token_Reference is
66
+ (if Style = GNATdoc.Comments.Options.GNAT
67
+ then Token.Next
68
+ else Token.Previous);
69
+ -- Go to next or previous token depending on 'Style' value
70
+
71
+ function Valid_Comment return Boolean;
72
+ -- Return True if comment token is still part of 'Ref' comment.
73
+
74
+ -- -----------------
75
+ -- Valid_Comment --
76
+ -- -----------------
77
+
78
+ function Valid_Comment return Boolean is
79
+ Current_Line : constant Slocs.Line_Number :=
80
+ Token.Data.Sloc_Range.Start_Line;
81
+ Valid : Boolean := False;
82
+ begin
83
+ case Style is
84
+ when GNATdoc.Comments.Options.GNAT =>
85
+ if Current_Line <= Line + 1 then
86
+ Valid := True;
87
+ end if ;
88
+ when GNATdoc.Comments.Options.Leading =>
89
+ if Current_Line >= Line - 1 then
90
+ Valid := True;
91
+ end if ;
92
+ end case ;
93
+ if Valid then
94
+ -- update Line to allow next/previous comment to still be valid
95
+ Line := Current_Line;
96
+ end if ;
97
+ return Valid;
98
+ end Valid_Comment ;
99
+
100
+ use type Gpr_Parser.Common.Token_Reference;
101
+ use type Gpr_Parser.Common.Token_Kind;
102
+ begin
103
+ Token := Next;
104
+ while Token /= Gpr_Parser.Common.No_Token loop
105
+ if Token.Data.Kind = Gpr_Parser.Common.Gpr_Comment
106
+ then
107
+ if Valid_Comment then
108
+ case Style is
109
+ when GNATdoc.Comments.Options.GNAT =>
110
+ if Add_LF then
111
+ Documentation.Append
112
+ (VSS.Strings.To_Virtual_String
113
+ (Ada.Characters.Wide_Wide_Latin_1.LF & Token.Text));
114
+ else
115
+ Documentation.Append
116
+ (VSS.Strings.To_Virtual_String
117
+ (Token.Text));
118
+ end if ;
119
+ when GNATdoc.Comments.Options.Leading =>
120
+ if Add_LF then
121
+ Documentation.Prepend
122
+ (VSS.Strings.To_Virtual_String
123
+ (Token.Text & Ada.Characters.Wide_Wide_Latin_1.LF));
124
+ else
125
+ Documentation.Prepend
126
+ (VSS.Strings.To_Virtual_String
127
+ (Token.Text));
128
+ end if ;
129
+ end case ;
130
+ Add_LF := True;
131
+ else
132
+ exit ;
133
+ end if ;
134
+ end if ;
135
+ Token := Next;
136
+ end loop ;
137
+ return Documentation;
138
+ end Get_Documentation ;
139
+
140
+ -- --------------------
141
+ -- Get_Tooltip_Text --
142
+ -- --------------------
143
+
35
144
procedure Get_Tooltip_Text
36
- (Self : LSP.GPR_Files.File_Access;
37
- URI : LSP.Structures.DocumentUri;
38
- Document_Provider : LSP.GPR_Documents.Document_Provider_Access;
39
- Position : LSP.Structures.Position;
40
- Tooltip_Text : out VSS.Strings.Virtual_String) is
145
+ (Self : LSP.GPR_Files.File_Access;
146
+ URI : LSP.Structures.DocumentUri;
147
+ Document_Provider : LSP.GPR_Documents.Document_Provider_Access;
148
+ Position : LSP.Structures.Position;
149
+ Style : GNATdoc.Comments.Options.Documentation_Style;
150
+ Declaration_Text : out VSS.Strings.Virtual_String;
151
+ Documentation_Text : out VSS.Strings.Virtual_String;
152
+ Location_Text : out VSS.Strings.Virtual_String) is
41
153
use Gpr_Parser.Common;
42
154
43
155
package LKD renames LSP.Text_Documents.Langkit_Documents;
@@ -69,6 +181,7 @@ package body LSP.GPR_Documentation is
69
181
begin
70
182
if Reference.Is_Variable_Reference
71
183
or else Reference.Is_Attribute_Reference
184
+ or else Reference.Is_Type_Reference
72
185
then
73
186
declare
74
187
Document : constant LSP.GPR_Documents.Document_Access :=
@@ -85,9 +198,27 @@ package body LSP.GPR_Documentation is
85
198
Reference => Reference);
86
199
begin
87
200
if Variable.Is_Defined then
88
- Tooltip_Text .Append
201
+ Declaration_Text .Append
89
202
(VSS.Strings.Conversions.To_Virtual_String
90
203
(GPR2.Project.Variable.Image (Variable)));
204
+ Location_Text.Append
205
+ (VSS.Strings.Conversions.To_Virtual_String
206
+ (GPR2.Source_Reference.Format
207
+ (GPR2.Source_Reference.Object
208
+ (Variable))));
209
+ if Variable.Has_Type then
210
+ declare
211
+ Typ : constant GPR2.Project.Typ.Object :=
212
+ Variable.Typ;
213
+ begin
214
+ if Typ.Is_Defined then
215
+ Declaration_Text.Prepend
216
+ (VSS.Strings.Conversions.To_Virtual_String
217
+ (GPR2.Project.Typ.Image (Typ)
218
+ & Ada.Characters.Latin_1.CR));
219
+ end if ;
220
+ end ;
221
+ end if ;
91
222
end if ;
92
223
end ;
93
224
elsif Reference.Is_Attribute_Reference then
@@ -98,12 +229,39 @@ package body LSP.GPR_Documentation is
98
229
Reference => Reference);
99
230
begin
100
231
if Attribute.Is_Defined then
101
- Tooltip_Text .Append
232
+ Declaration_Text .Append
102
233
(VSS.Strings.Conversions.To_Virtual_String
103
234
(GPR2.Project.Attribute.Image (Attribute)
104
235
& Ada.Characters.Latin_1.CR));
236
+ Location_Text.Append
237
+ (VSS.Strings.Conversions.To_Virtual_String
238
+ (GPR2.Source_Reference.Format
239
+ (GPR2.Source_Reference.Object
240
+ (Attribute))));
241
+ end if ;
242
+
243
+ end ;
244
+ elsif Reference.Is_Type_Reference then
245
+ declare
246
+ Typ : constant GPR2.Project.Typ.Object :=
247
+ Document.Get_Type
248
+
249
+ (Root_File => Self,
250
+ Reference => Reference);
251
+ begin
252
+ if Typ.Is_Defined then
253
+ Declaration_Text.Append
254
+ (VSS.Strings.Conversions.To_Virtual_String
255
+ (GPR2.Project.Typ.Image (Typ)
256
+ & Ada.Characters.Latin_1.CR));
257
+ Location_Text.Append
258
+ (VSS.Strings.Conversions.To_Virtual_String
259
+ (GPR2.Source_Reference.Format
260
+ (GPR2.Source_Reference.Object
261
+ (Typ))));
105
262
end if ;
106
263
end ;
264
+
107
265
end if ;
108
266
end if ;
109
267
end ;
@@ -112,8 +270,6 @@ package body LSP.GPR_Documentation is
112
270
113
271
begin
114
272
115
- Tooltip_Text.Clear;
116
-
117
273
if Token /= No_Token and then Token.Data.Kind = Gpr_Identifier then
118
274
declare
119
275
Reference : constant FR.Reference :=
@@ -127,14 +283,14 @@ package body LSP.GPR_Documentation is
127
283
if Previous /= No_Token then
128
284
case Previous.Data.Kind is
129
285
when Gpr_Package | Gpr_End =>
130
- Tooltip_Text .Append
286
+ Documentation_Text .Append
131
287
(VSS.Strings.Conversions.To_Virtual_String
132
288
(Get_Package_Description
133
289
(Self.Get_Package (Position))));
134
290
135
291
when Gpr_For =>
136
292
Append_Value (Reference);
137
- Tooltip_Text .Append
293
+ Documentation_Text .Append
138
294
(VSS.Strings.Conversions.To_Virtual_String
139
295
(Get_Attribute_Description ((
140
296
Self.Get_Package (Position),
@@ -143,24 +299,32 @@ package body LSP.GPR_Documentation is
143
299
when others =>
144
300
Append_Value (Reference);
145
301
if Reference.Is_Package_Reference then
146
- Tooltip_Text .Append
302
+ Documentation_Text .Append
147
303
(VSS.Strings.Conversions.To_Virtual_String
148
304
(Get_Package_Description
149
305
(Reference.Referenced_Package)));
150
- else
306
+ elsif Reference.Is_Attribute_Reference then
151
307
declare
152
308
Attribute : constant FR.Attribute_Definition :=
153
309
Reference.Referenced_Attribute;
154
310
155
311
use type FR.Attribute_Definition;
156
312
begin
157
313
if Attribute /= FR.No_Attribute_Definition then
158
- Tooltip_Text .Append
314
+ Documentation_Text .Append
159
315
(VSS.Strings.Conversions.To_Virtual_String
160
316
(Get_Attribute_Description
161
317
(Attribute.Name)));
162
318
end if ;
163
319
end ;
320
+ elsif Reference.Is_Variable_Reference
321
+ or else Reference.Is_Type_Reference
322
+ then
323
+ Documentation_Text.Append
324
+ (Get_Documentation
325
+ (LSP.GPR_Files.References.Token_Reference
326
+ (Self, Position),
327
+ Style));
164
328
end if ;
165
329
end case ;
166
330
end if ;
0 commit comments