ada/gnatdoc
0
0
Fork 0
mirror of https://github.com/AdaCore/gnatdoc.git synced 2026-02-12 13:11:07 -08:00
Code Issues Packages Projects Releases Wiki Activity

Use VSS String_Template to format message.

Browse Source
This commit is contained in:
Vadim Godunko
2024-09-26 13:37:33 +04:00
parent ce512b0a4a
commit f831fd26bd
3 changed files with 153 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

64
source/gnatdoc/gnatdoc-projects.adb
View File

@@ -18,7 +18,6 @@
with Ada.Containers.Hashed_Sets;
with Ada.Strings.Hash;
with GNATCOLL.Utils;
with Langkit_Support.Text;
with Libadalang.Common;
with Libadalang.Iterators;
@@ -49,15 +48,19 @@ with VSS.Application;
with VSS.Command_Line;
with VSS.Regular_Expressions;
with VSS.Strings.Conversions;
with VSS.Strings.Formatters.Integers;
with VSS.Strings.Formatters.Strings;
with VSS.Strings.Formatters.Virtual_Files;
with VSS.Strings.Templates;
with GNATdoc.Command_Line;
with GNATdoc.Messages;
with GNATdoc.Options;
with GNATCOLL.VFS; use GNATCOLL.VFS;
package body GNATdoc.Projects is
use type GNATCOLL.VFS.Virtual_File;
Documentation_Package : constant GPR2.Package_Id :=
GPR2."+" ("documentation");
@@ -100,7 +103,7 @@ package body GNATdoc.Projects is
package Virtual_File_Sets is
new Ada.Containers.Hashed_Sets
(GNATCOLL.VFS.Virtual_File, Hash, GNATCOLL.VFS."=");
(GNATCOLL.VFS.Virtual_File, Hash, GNATCOLL.VFS."=", GNATCOLL.VFS."=");
Project_Tree : GPR2.Project.Tree.Object;
Exclude_Project_Files : Virtual_File_Sets.Set;
@@ -216,6 +219,8 @@ package body GNATdoc.Projects is
(Documentation_Excluded_Project_Files)
then
declare
use type VSS.Strings.Virtual_String;
Attribute : constant GPR2.Project.Attribute.Object :=
Project_Tree.Root_Project.Attribute
(Documentation_Excluded_Project_Files);
@@ -223,7 +228,10 @@ package body GNATdoc.Projects is
Project_Names : Virtual_File_Sets.Set;
This_File : GNATCOLL.VFS.Virtual_File;
procedure Report_Error_On_Attribute (Message : String);
procedure Report_Error_On_Attribute
(Message : VSS.Strings.Virtual_String;
Text : VSS.Strings.Virtual_String :=
VSS.Strings.Empty_Virtual_String);
-- Report the given Message on the
-- Documentation.Excluded_Project_Files attraibute and
-- terminate application with appropriate error status.
@@ -235,28 +243,34 @@ package body GNATdoc.Projects is
-- Report_Error_On_Attribute --
-------------------------------
procedure Report_Error_On_Attribute (Message : String) is
GPR_File : constant Virtual_File :=
Create (Filesystem_String (Attribute.Filename));
Error_Msg : constant String :=
GPR_File.Display_Base_Name
& ":" & GNATCOLL.Utils.Image (Attribute.Line, 1)
& ":" & GNATCOLL.Utils.Image (Attribute.Column, 1)
& ": error:"
& Message;
procedure Report_Error_On_Attribute
(Message : VSS.Strings.Virtual_String;
Text : VSS.Strings.Virtual_String :=
VSS.Strings.Empty_Virtual_String)
is
File : constant GNATCOLL.VFS.Virtual_File :=
GNATCOLL.VFS.Create_From_UTF8 (String (Attribute.Filename));
Error_Template : constant
VSS.Strings.Templates.Virtual_String_Template :=
"{}:{}:{}: error: {}{}";
begin
VSS.Command_Line.Report_Error
(VSS.Strings.Conversions.To_Virtual_String
(Error_Msg));
(Error_Template.Format
(VSS.Strings.Formatters.Virtual_Files.Image (File),
VSS.Strings.Formatters.Integers.Image (Attribute.Line),
VSS.Strings.Formatters.Integers.Image (Attribute.Column),
VSS.Strings.Formatters.Strings.Image (Message),
VSS.Strings.Formatters.Strings.Image (Text)));
end Report_Error_On_Attribute;
begin
-- Create a set containing all valid project names
for View of Project_Tree.Root_Project.Closure
(Include_Self => True)
loop
Project_Names.Include
(Create (View.Path_Name.Filesystem_String));
Project_Names.Include (View.Path_Name.Virtual_File);
end loop;
for Item of Attribute.Values loop
@@ -270,17 +284,19 @@ package body GNATdoc.Projects is
-- The excluded projects can be listed as paths relative to the
-- root project, so make sure to create them relatively from
-- the project's root directory.
This_File := Create_From_Base
(Base_Name => Filesystem_String (Item.Text),
Base_Dir =>
Project_Tree.Root_Project.Dir_Name.Filesystem_String);
This_File :=
GNATCOLL.VFS.Create_From_Base
(Base_Name => GNATCOLL.VFS.Filesystem_String (Item.Text),
Base_Dir =>
Project_Tree.Root_Project.Dir_Name.Filesystem_String);
if not Project_Names.Contains (This_File) then
Report_Error_On_Attribute
("unable to resolve project file path specified in "
& "the 'Documentation.Excluded_Project_Files' "
& "project attribute: "
& Item.Text);
& "project attribute: ",
VSS.Strings.Conversions.To_Virtual_String (Item.Text));
end if;
Exclude_Project_Files.Insert (This_File);

66
source/vss-strings-formatters-virtual_files.adb Normal file
View File

@@ -0,0 +1,66 @@
------------------------------------------------------------------------------
-- GNAT Documentation Generation Tool --
-- --
-- Copyright (C) 2024, AdaCore --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
-- License for more details. You should have received a copy of the GNU --
-- General Public License distributed with this software; see file --
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
-- of the license. --
------------------------------------------------------------------------------
with VSS.Strings.Conversions;
package body VSS.Strings.Formatters.Virtual_Files is
------------
-- Format --
------------
overriding function Format
(Self : Formatter;
Format : VSS.Strings.Formatters.Format_Information)
return VSS.Strings.Virtual_String is
begin
return
VSS.Strings.Conversions.To_Virtual_String
(Self.Value.Display_Base_Name);
end Format;
-----------
-- Image --
-----------
function Image (Item : GNATCOLL.VFS.Virtual_File) return Formatter is
begin
return (Name => <>, Value => Item);
end Image;
-----------
-- Image --
-----------
function Image
(Name : VSS.Strings.Virtual_String;
Item : GNATCOLL.VFS.Virtual_File) return Formatter is
begin
return (Name => Name, Value => Item);
end Image;
----------
-- Name --
----------
overriding function Name
(Self : Formatter) return VSS.Strings.Virtual_String is
begin
return Self.Name;
end Name;
end VSS.Strings.Formatters.Virtual_Files;

47
source/vss-strings-formatters-virtual_files.ads Normal file
View File

@@ -0,0 +1,47 @@
------------------------------------------------------------------------------
-- GNAT Documentation Generation Tool --
-- --
-- Copyright (C) 2024, AdaCore --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
-- License for more details. You should have received a copy of the GNU --
-- General Public License distributed with this software; see file --
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
-- of the license. --
------------------------------------------------------------------------------
with GNATCOLL.VFS;
package VSS.Strings.Formatters.Virtual_Files is
type Formatter is
new VSS.Strings.Formatters.Abstract_Formatter with private;
function Image (Item : GNATCOLL.VFS.Virtual_File) return Formatter;
function Image
(Name : VSS.Strings.Virtual_String;
Item : GNATCOLL.VFS.Virtual_File) return Formatter;
private
type Formatter is
new VSS.Strings.Formatters.Abstract_Formatter with record
Name : VSS.Strings.Virtual_String;
Value : GNATCOLL.VFS.Virtual_File;
end record;
overriding function Name
(Self : Formatter) return VSS.Strings.Virtual_String;
overriding function Format
(Self : Formatter;
Format : VSS.Strings.Formatters.Format_Information)
return VSS.Strings.Virtual_String;
end VSS.Strings.Formatters.Virtual_Files;