Skip to content

Commit b10cc31

Browse files
godunkogodunko
committed
Refactoring: move code snippet extraction into own package
1 parent 86c1920 commit b10cc31

File tree

3 files changed

+424
-370
lines changed

3 files changed

+424
-370
lines changed

‎source/gnatdoc-comments-extractor-code_snippets.adb‎

Lines changed: 374 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,374 @@
1+
------------------------------------------------------------------------------
2+
-- GNAT Documentation Generation Tool --
3+
-- --
4+
-- Copyright (C) 2025, 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 VSS.Characters.Latin;
19+
with VSS.Strings.Character_Iterators;
20+
21+
package body GNATdoc.Comments.Extractor.Code_Snippets is
22+
23+
use Libadalang.Analysis;
24+
use Libadalang.Slocs;
25+
use VSS.Characters;
26+
use VSS.Characters.Latin;
27+
use VSS.Strings;
28+
use VSS.Strings.Character_Iterators;
29+
use VSS.String_Vectors;
30+
31+
Ada_New_Line_Function : constant Line_Terminator_Set :=
32+
[CR | LF | CRLF => True, others => False];
33+
34+
-----------------------
35+
-- Fill_Code_Snippet --
36+
-----------------------
37+
38+
procedure Fill_Code_Snippet
39+
(Node : Ada_Node'Class;
40+
First_Token : Token_Reference;
41+
Last_Token : Token_Reference;
42+
Sections : in out Section_Vectors.Vector)
43+
is
44+
45+
procedure Remove_Leading_Spaces
46+
(Text : in out VSS.String_Vectors.Virtual_String_Vector;
47+
Line_Index : Positive;
48+
Amount : VSS.Strings.Character_Count);
49+
-- Remove given amount of space characters from the line of the given
50+
-- index.
51+
52+
---------------------------
53+
-- Remove_Leading_Spaces --
54+
---------------------------
55+
56+
procedure Remove_Leading_Spaces
57+
(Text : in out VSS.String_Vectors.Virtual_String_Vector;
58+
Line_Index : Positive;
59+
Amount : VSS.Strings.Character_Count)
60+
is
61+
Line : constant Virtual_String := Text (Line_Index);
62+
Iterator : Character_Iterator := Line.At_First_Character;
63+
Count : Character_Count := Amount;
64+
65+
begin
66+
while Iterator.Forward loop
67+
exit when Iterator.Element /= Space;
68+
69+
Count := Count - 1;
70+
71+
if Count = 0 then
72+
Text.Replace (Line_Index, Line.Tail_From (Iterator));
73+
74+
exit;
75+
end if;
76+
end loop;
77+
end Remove_Leading_Spaces;
78+
79+
First_Token_Location : constant Source_Location_Range :=
80+
Sloc_Range (Data (First_Token));
81+
Snippet_Section : Section_Access;
82+
Text : Virtual_String_Vector;
83+
84+
begin
85+
Text :=
86+
To_Virtual_String
87+
(Libadalang.Common.Text (First_Token, Last_Token)).Split_Lines
88+
(Ada_New_Line_Function);
89+
90+
-- Indent first line correctly.
91+
92+
declare
93+
Line : Virtual_String := Text (1);
94+
95+
begin
96+
for J in 2 .. First_Token_Location.Start_Column loop
97+
Line.Prepend (' ');
98+
end loop;
99+
100+
Text.Replace (1, Line);
101+
end;
102+
103+
-- Remove comments
104+
105+
if First_Token /= Last_Token then
106+
declare
107+
Line_Offset : constant Line_Number :=
108+
First_Token_Location.Start_Line - 1;
109+
Token : Token_Reference := Last_Token;
110+
111+
begin
112+
loop
113+
Token := Previous (Token);
114+
115+
exit when Token = First_Token or Token = No_Token;
116+
117+
if Kind (Data (Token)) = Ada_Comment then
118+
declare
119+
Location : constant Source_Location_Range :=
120+
Sloc_Range (Data (Token));
121+
Index : constant Positive :=
122+
Positive (Location.Start_Line - Line_Offset);
123+
Line : Virtual_String := Text (Index);
124+
Iterator : Character_Iterator :=
125+
Line.After_Last_Character;
126+
127+
begin
128+
-- Move iterator till first character before the
129+
-- comment's start column.
130+
131+
while Iterator.Backward loop
132+
exit when
133+
Iterator.Character_Index
134+
< Character_Index (Location.Start_Column);
135+
end loop;
136+
137+
-- Rewind all whitespaces before the comment
138+
139+
while Iterator.Backward loop
140+
exit when not Is_Ada_Separator (Iterator.Element);
141+
end loop;
142+
143+
-- Remove comment and spaces before it from the line.
144+
145+
Line := Line.Slice (Line.At_First_Character, Iterator);
146+
Text.Replace (Index, Line);
147+
end;
148+
end if;
149+
end loop;
150+
end;
151+
end if;
152+
153+
-- For enumeration types with large number of defined enumeration
154+
-- literals, limit text for few first literals and last literal.
155+
156+
if Node.Kind = Ada_Concrete_Type_Decl
157+
and then Node.As_Concrete_Type_Decl.F_Type_Def.Kind
158+
= Ada_Enum_Type_Def
159+
then
160+
declare
161+
procedure Move_At
162+
(Iterator : in out Character_Iterator;
163+
Position : Character_Index);
164+
165+
-------------
166+
-- Move_At --
167+
-------------
168+
169+
procedure Move_At
170+
(Iterator : in out Character_Iterator;
171+
Position : Character_Index) is
172+
begin
173+
if Iterator.Character_Index = Position then
174+
return;
175+
176+
elsif Iterator.Character_Index < Position then
177+
while Iterator.Forward loop
178+
exit when Iterator.Character_Index = Position;
179+
end loop;
180+
181+
else
182+
while Iterator.Backward loop
183+
exit when Iterator.Character_Index = Position;
184+
end loop;
185+
end if;
186+
end Move_At;
187+
188+
Max_Enum_Literals : constant := 10;
189+
-- Maximum number of the enumeration literals presented in the
190+
-- code snippet.
191+
192+
Line_Offset : constant Line_Number :=
193+
First_Token_Location.Start_Line - 1;
194+
Literals : constant Enum_Literal_Decl_List :=
195+
Node.As_Concrete_Type_Decl.F_Type_Def.As_Enum_Type_Def
196+
.F_Enum_Literals;
197+
198+
begin
199+
if Literals.Children_Count > Max_Enum_Literals then
200+
-- Replace enumeration literal before the last enumeration
201+
-- literal of the type by the horizontal ellipsis.
202+
203+
declare
204+
Location : constant Source_Location_Range :=
205+
Literals.Child (Literals.Last_Child_Index - 1).Sloc_Range;
206+
Index : constant Positive :=
207+
Positive (Location.Start_Line - Line_Offset);
208+
Line : Virtual_String := Text (Index);
209+
E_Iterator : Character_Iterator :=
210+
Line.After_Last_Character;
211+
S_Iterator : Character_Iterator :=
212+
Line.After_Last_Character;
213+
214+
begin
215+
Move_At
216+
(S_Iterator, Character_Index (Location.Start_Column));
217+
Move_At
218+
(E_Iterator, Character_Index (Location.End_Column) - 1);
219+
Line.Replace (S_Iterator, E_Iterator, "…");
220+
Text.Replace (Index, Line);
221+
end;
222+
223+
-- Remove all other intermediate enumeration literals.
224+
225+
for J in reverse
226+
Literals.First_Child_Index + Max_Enum_Literals - 2
227+
.. Literals.Last_Child_Index - 2
228+
loop
229+
declare
230+
Location : constant Source_Location_Range :=
231+
Literals.Child (J).Sloc_Range;
232+
Index : constant Positive :=
233+
Positive (Location.Start_Line - Line_Offset);
234+
Line : Virtual_String := Text (Index);
235+
E_Iterator : Character_Iterator :=
236+
Line.After_Last_Character;
237+
S_Iterator : Character_Iterator :=
238+
Line.After_Last_Character;
239+
240+
begin
241+
Move_At
242+
(S_Iterator, Character_Index (Location.Start_Column));
243+
Move_At
244+
(E_Iterator, Character_Index (Location.End_Column) - 1);
245+
246+
while S_Iterator.Backward loop
247+
exit when not Is_Ada_Separator (S_Iterator.Element);
248+
end loop;
249+
250+
if S_Iterator.Has_Element then
251+
Line.Delete (S_Iterator, E_Iterator);
252+
Text.Replace (Index, Line);
253+
254+
else
255+
Line.Delete (Line.At_First_Character, E_Iterator);
256+
257+
declare
258+
Previous : Virtual_String := Text (Index - 1);
259+
260+
begin
261+
E_Iterator.Set_At_Last (Previous);
262+
Previous.Delete
263+
(E_Iterator, Previous.At_Last_Character);
264+
Previous.Append (Line);
265+
Text.Replace (Index - 1, Previous);
266+
Text.Delete (Index);
267+
end;
268+
end if;
269+
end;
270+
end loop;
271+
end if;
272+
end;
273+
end if;
274+
275+
-- For record type add ';' at the end
276+
277+
if Node.Kind = Ada_Concrete_Type_Decl
278+
and then Node.As_Concrete_Type_Decl.F_Type_Def.Kind
279+
in Ada_Record_Type_Def | Ada_Derived_Type_Def
280+
and then not
281+
(Node.As_Concrete_Type_Decl.F_Type_Def.Kind = Ada_Derived_Type_Def
282+
and then Node.As_Concrete_Type_Decl.F_Type_Def.As_Derived_Type_Def
283+
.F_Record_Extension.Is_Null)
284+
then
285+
Text.Replace (Text.Length, Text.Last_Element & ";");
286+
end if;
287+
288+
-- Remove all empty lines
289+
290+
for Index in reverse 1 .. Text.Length loop
291+
if Text (Index).Is_Empty then
292+
Text.Delete (Index);
293+
end if;
294+
end loop;
295+
296+
-- For the subprogram specification check whether "overriding"/"not
297+
-- overriding" indicator is used at the same line with subprogram
298+
-- specification and reformat code snippet: first line of the
299+
-- subprogram specification is moved left to position of the indicator;
300+
-- if subprogram parameter is present on this line too, all lines
301+
-- below is moved too, unless any non-space characters are found in
302+
-- the removed slice of the line.
303+
304+
if Node.Kind = Ada_Subp_Spec
305+
and then Node.Parent.Kind
306+
in Ada_Classic_Subp_Decl | Ada_Base_Subp_Body
307+
then
308+
declare
309+
Indicator_Node : constant Overriding_Node :=
310+
(if Node.Parent.Kind in Ada_Classic_Subp_Decl
311+
then Node.Parent.As_Classic_Subp_Decl.F_Overriding
312+
else Node.Parent.As_Base_Subp_Body.F_Overriding);
313+
Indicator_Location : constant Source_Location_Range :=
314+
Indicator_Node.Sloc_Range;
315+
Offset : VSS.Strings.Character_Count := 0;
316+
317+
begin
318+
if Indicator_Node.Kind /= Ada_Overriding_Unspecified
319+
and then First_Token_Location.Start_Line
320+
= Indicator_Location.Start_Line
321+
then
322+
Offset :=
323+
VSS.Strings.Character_Count
324+
(First_Token_Location.Start_Column
325+
- Indicator_Location.Start_Column);
326+
end if;
327+
328+
if Offset /= 0 then
329+
Remove_Leading_Spaces (Text, 1, Offset);
330+
331+
declare
332+
Params_Node : constant Params :=
333+
Node.As_Subp_Spec.F_Subp_Params;
334+
P1_Node : Ada_Node;
335+
Success : Boolean;
336+
337+
begin
338+
if Params_Node /= No_Params then
339+
Params_Node.F_Params.Get_Child (1, Success, P1_Node);
340+
341+
if Success
342+
and then P1_Node.Sloc_Range.Start_Line
343+
= First_Token_Location.Start_Line
344+
then
345+
for J in 2 .. Text.Length loop
346+
Remove_Leading_Spaces (Text, J, Offset);
347+
end loop;
348+
end if;
349+
end if;
350+
end;
351+
end if;
352+
end;
353+
end if;
354+
355+
-- Remove indentation
356+
357+
declare
358+
Indent : constant VSS.Strings.Character_Count :=
359+
Count_Leading_Whitespaces (Text (1));
360+
361+
begin
362+
for Index in Text.First_Index .. Text.Last_Index loop
363+
Text.Replace
364+
(Index, Remove_Leading_Whitespaces (Text (Index), Indent));
365+
end loop;
366+
end;
367+
368+
Snippet_Section :=
369+
new Section'
370+
(Kind => Snippet, Symbol => "ada", Text => Text, others => <>);
371+
Sections.Append (Snippet_Section);
372+
end Fill_Code_Snippet;
373+
374+
end GNATdoc.Comments.Extractor.Code_Snippets;

0 commit comments

Comments
 (0)