Skip to content

Commit 1117c93

Browse files
godunkogodunko
committed
Merge branch 'topic/vadim/xml' into 'master'
Initial implementation of XML backend See merge request eng/ide/gnatdoc!214
2 parents 5106ada + 3d9e8b6 commit 1117c93

8 files changed

+386
-0
lines changed

‎gnat/gnatdoc.gpr‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ project GNATdoc is
3030
"../source/backend/odf",
3131
"../source/backend/rst",
3232
"../source/backend/test",
33+
"../source/backend/xml",
3334
"../source/backend/xml_templates",
3435
"../source/frontend",
3536
"../source/gnatdoc");

‎source/backend/gnatdoc-backend-registry.adb‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ with GNATdoc.Backend.HTML;
1919
with GNATdoc.Backend.ODF;
2020
with GNATdoc.Backend.RST.PT;
2121
with GNATdoc.Backend.Test;
22+
with GNATdoc.Backend.XML;
2223

2324
package body GNATdoc.Backend.Registry is
2425

@@ -46,6 +47,9 @@ package body GNATdoc.Backend.Registry is
4647

4748
elsif Name = "test" then
4849
return new GNATdoc.Backend.Test.Test_Backend;
50+
51+
elsif Name = "xml" then
52+
return new GNATdoc.Backend.XML.XML_Backend;
4953
end if;
5054

5155
return null;

‎source/backend/xml/gnatdoc-backend-xml.adb‎

Lines changed: 157 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,157 @@
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.IRIs;
19+
with VSS.Strings.Formatters.Generic_Integers;
20+
with VSS.Strings.Formatters.Strings;
21+
with VSS.Strings.Templates;
22+
with VSS.XML.Attributes.Containers;
23+
with VSS.XML.Writers.Pretty;
24+
25+
with GNATdoc.Backend.XML_Namespaces;
26+
with GNATdoc.Comments.XML_Helpers;
27+
with Streams;
28+
29+
package body GNATdoc.Backend.XML is
30+
31+
use GNATdoc.Backend.XML_Namespaces;
32+
33+
package Character_Count_Formatters is
34+
new VSS.Strings.Formatters.Generic_Integers (VSS.Strings.Character_Count);
35+
use Character_Count_Formatters;
36+
-- XXX VSS 20251204+ provides it as
37+
-- `VSS.Strings.Formatters.Character_Offsets`.
38+
39+
package Line_Count_Formatters is
40+
new VSS.Strings.Formatters.Generic_Integers (VSS.Strings.Line_Count);
41+
use Line_Count_Formatters;
42+
-- XXX VSS 20251204+ provides it as `VSS.Strings.Formatters.Line_Offsets`.
43+
44+
GNATdoc_Element : constant VSS.Strings.Virtual_String := "gnatdoc";
45+
46+
--------------
47+
-- Generate --
48+
--------------
49+
50+
overriding procedure Generate (Self : in out XML_Backend) is
51+
52+
procedure Generate
53+
(Writer : in out VSS.XML.Writers.XML_Writer'Class;
54+
Entity : not null GNATdoc.Entities.Entity_Information_Access;
55+
Success : in out Boolean);
56+
57+
--------------
58+
-- Generate --
59+
--------------
60+
61+
procedure Generate
62+
(Writer : in out VSS.XML.Writers.XML_Writer'Class;
63+
Entity : not null GNATdoc.Entities.Entity_Information_Access;
64+
Success : in out Boolean)
65+
is
66+
Attributes : VSS.XML.Attributes.Containers.Attributes;
67+
Signatures : VSS.String_Vectors.Virtual_String_Vector;
68+
Location_Template : VSS.Strings.Templates.Virtual_String_Template :=
69+
"{}:{}:{}";
70+
71+
begin
72+
Attributes.Clear;
73+
Attributes.Insert
74+
(VSS.IRIs.Empty_IRI,
75+
"kind",
76+
VSS.Strings.To_Virtual_String
77+
(GNATdoc.Entities.Entity_Kind'Wide_Wide_Image (Entity.Kind)));
78+
Attributes.Insert
79+
(VSS.IRIs.Empty_IRI,
80+
"location",
81+
Location_Template.Format
82+
(VSS.Strings.Formatters.Strings.Image (Entity.Location.File),
83+
Image (Entity.Location.Line),
84+
Image (Entity.Location.Column)));
85+
Attributes.Insert
86+
(VSS.IRIs.Empty_IRI, "signature", Entity.Signature.Image);
87+
Attributes.Insert (VSS.IRIs.Empty_IRI, "name", Entity.Name);
88+
Attributes.Insert
89+
(VSS.IRIs.Empty_IRI, "qualified_name", Entity.Qualified_Name);
90+
91+
if not GNATdoc.Entities.Is_Undefined (Entity.Parent_Type) then
92+
Attributes.Insert
93+
(VSS.IRIs.Empty_IRI,
94+
"parent_type",
95+
Entity.Parent_Type.Signature.Image);
96+
end if;
97+
98+
for Progenitor of Entity.Progenitor_Types loop
99+
Signatures.Append (Progenitor.Signature.Image);
100+
end loop;
101+
102+
if not Signatures.Is_Empty then
103+
Attributes.Insert
104+
(VSS.IRIs.Empty_IRI, "progenitor_types", Signatures.Join (' '));
105+
end if;
106+
107+
Writer.Start_Element
108+
(GNATdoc_Namespace, "entity", Attributes, Success);
109+
110+
GNATdoc.Comments.XML_Helpers.Generate
111+
(Entity.Documentation, Writer, Success);
112+
113+
for E of Entity.Entities loop
114+
Generate (Writer, E, Success);
115+
end loop;
116+
117+
Writer.End_Element (GNATdoc_Namespace, "entity", Success);
118+
end Generate;
119+
120+
Writer : aliased VSS.XML.Writers.Pretty.Pretty_XML_Writer;
121+
Output : aliased Streams.Output_Text_Stream;
122+
Success : Boolean := True;
123+
Attributes : VSS.XML.Attributes.Containers.Attributes;
124+
125+
begin
126+
-- Open output file.
127+
128+
Output.Open
129+
(GNATCOLL.VFS.Create_From_Dir
130+
(Self.Output_Root, "documentation.xml"));
131+
132+
-- Connect components
133+
134+
Writer.Set_Output_Stream (Output'Unchecked_Access);
135+
Writer.Set_Indent (2);
136+
137+
-- Generate XML document
138+
139+
Writer.Start_Document (Success);
140+
Writer.Start_Prefix_Mapping ("", GNATdoc_Namespace, Success);
141+
142+
Attributes.Clear;
143+
Writer.Start_Element
144+
(GNATdoc_Namespace, GNATdoc_Element, Attributes, Success);
145+
146+
for E of GNATdoc.Entities.Globals.Entities loop
147+
Generate (Writer, E, Success);
148+
end loop;
149+
150+
Writer.End_Element (GNATdoc_Namespace, GNATdoc_Element, Success);
151+
152+
-- Close output file.
153+
154+
Output.Close;
155+
end Generate;
156+
157+
end GNATdoc.Backend.XML;

‎source/backend/xml/gnatdoc-backend-xml.ads‎

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
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+
-- XML backend
19+
20+
package GNATdoc.Backend.XML is
21+
22+
type XML_Backend is new Abstract_Backend with private;
23+
24+
private
25+
26+
type XML_Backend is new Abstract_Backend with record
27+
null;
28+
end record;
29+
30+
overriding procedure Generate (Self : in out XML_Backend);
31+
32+
overriding procedure Add_Command_Line_Options
33+
(Self : XML_Backend;
34+
Parser : in out VSS.Command_Line.Parsers.Command_Line_Parser'Class)
35+
is null;
36+
37+
overriding procedure Process_Command_Line_Options
38+
(Self : in out XML_Backend;
39+
Parser : VSS.Command_Line.Parsers.Command_Line_Parser'Class) is null;
40+
41+
overriding function Name
42+
(Self : in out XML_Backend) return VSS.Strings.Virtual_String is ("xml");
43+
44+
end GNATdoc.Backend.XML;

‎source/backend/xml/gnatdoc-backend-xml_namespaces.ads‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
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.IRIs;
19+
20+
package GNATdoc.Backend.XML_Namespaces is
21+
22+
GNATdoc_Namespace : constant VSS.IRIs.IRI :=
23+
"http://adacore.com/schema/gnatdoc";
24+
-- XML namespace used by GNATdoc
25+
26+
end GNATdoc.Backend.XML_Namespaces;

‎source/backend/xml/gnatdoc-comments-xml_helpers.adb‎

Lines changed: 123 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
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.IRIs;
19+
with VSS.XML.Attributes.Containers;
20+
21+
with GNATdoc.Backend.XML_Namespaces;
22+
23+
package body GNATdoc.Comments.XML_Helpers is
24+
25+
use GNATdoc.Backend.XML_Namespaces;
26+
27+
Description_Element : constant VSS.Strings.Virtual_String := "description";
28+
Formal_Element : constant VSS.Strings.Virtual_String := "formal";
29+
Enumeration_Literal_Element : constant VSS.Strings.Virtual_String :=
30+
"enumeration_literal";
31+
Component_Element : constant VSS.Strings.Virtual_String := "component";
32+
Parameter_Element : constant VSS.Strings.Virtual_String := "parameter";
33+
Return_Element : constant VSS.Strings.Virtual_String := "return";
34+
Raised_Exception_Element : constant VSS.Strings.Virtual_String :=
35+
"raised_exception";
36+
37+
--------------
38+
-- Generate --
39+
--------------
40+
41+
procedure Generate
42+
(Comment : Structured_Comment;
43+
Writer : in out VSS.XML.Writers.XML_Writer'Class;
44+
Success : in out Boolean)
45+
is
46+
Attributes : VSS.XML.Attributes.Containers.Attributes;
47+
Element : VSS.Strings.Virtual_String;
48+
49+
begin
50+
Attributes.Clear;
51+
Writer.Start_Element
52+
(GNATdoc_Namespace, "documentation", Attributes, Success);
53+
54+
for Section of Comment.Sections loop
55+
if Section.Kind = Description
56+
and then not Section.Text.Is_Empty
57+
then
58+
Attributes.Clear;
59+
Writer.Start_Element
60+
(GNATdoc_Namespace, Description_Element, Attributes, Success);
61+
Writer.Characters
62+
(Section.Text.Join_Lines (VSS.Strings.LF, False), Success);
63+
Writer.End_Element
64+
(GNATdoc_Namespace, Description_Element, Success);
65+
end if;
66+
end loop;
67+
68+
for Section of Comment.Sections loop
69+
if Section.Kind in Component then
70+
case Section.Kind is
71+
when Formal =>
72+
Element := Formal_Element;
73+
74+
when Enumeration_Literal =>
75+
Element := Enumeration_Literal_Element;
76+
77+
when Field =>
78+
Element := Component_Element;
79+
80+
when Parameter =>
81+
Element := Parameter_Element;
82+
83+
when Returns =>
84+
Element := Return_Element;
85+
86+
when Raised_Exception =>
87+
Element := Raised_Exception_Element;
88+
89+
when others =>
90+
-- Should never happened
91+
92+
raise Program_Error with "unexpected kind of section";
93+
end case;
94+
95+
Attributes.Clear;
96+
97+
if Section.Kind /= Returns then
98+
Attributes.Insert
99+
(VSS.IRIs.Empty_IRI, "name", Section.Name);
100+
end if;
101+
102+
Writer.Start_Element
103+
(GNATdoc_Namespace, Element, Attributes, Success);
104+
105+
if not Section.Text.Is_Empty then
106+
Attributes.Clear;
107+
Writer.Start_Element
108+
(GNATdoc_Namespace, Description_Element, Attributes, Success);
109+
Writer.Characters
110+
(Section.Text.Join_Lines (VSS.Strings.LF, False), Success);
111+
Writer.End_Element
112+
(GNATdoc_Namespace, Description_Element, Success);
113+
end if;
114+
115+
Writer.End_Element
116+
(GNATdoc_Namespace, Element, Success);
117+
end if;
118+
end loop;
119+
120+
Writer.End_Element (GNATdoc_Namespace, "documentation", Success);
121+
end Generate;
122+
123+
end GNATdoc.Comments.XML_Helpers;

0 commit comments

Comments
 (0)