--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with Interfaces.C.Extensions;
with Interfaces.C.Pointers;

with GL.Algebra;

package GL.Types is
   pragma Preelaborate;

   -- These are the types you can and should use with OpenGL functions
   -- (particularly when dealing with buffer objects).
   -- Types that are only used internally, but may be needed when interfacing
   -- with OpenGL-related library APIs can be found in GL.Low_Level.

   --  Signed integer types
   type Byte  is new C.signed_char;
   type Short is new C.short;
   type Int   is new C.int;
   type Long  is new C.Extensions.long_long;

   subtype Size is Int range 0 .. Int'Last;
   subtype Long_Size is Long range 0 .. Long'Last;

   --  Unsigned integer types
   type UByte  is new C.unsigned_char;
   type UShort is new C.unsigned_short;
   type UInt   is new C.unsigned;

   --  Floating point types ("Single" is used to avoid conflicts with Float)
   subtype Half is Short;  --  F16C extension can be used to convert from/to Single
   type Single is new C.C_float;
   type Double is new C.double;

   subtype Normalized_Single is Single range 0.0 .. 1.0;

   --  Array types
   type UByte_Array  is array (Size range <>) of aliased UByte;
   type UShort_Array is array (Size range <>) of aliased UShort;
   type Int_Array    is array (Size range <>) of aliased Int;
   type UInt_Array   is array (Size range <>) of aliased UInt;
   type Half_Array   is array (Size range <>) of aliased Half;
   type Single_Array is array (Size range <>) of aliased Single;
   type Double_Array is array (Size range <>) of aliased Double;

   pragma Convention (C, UByte_Array);
   pragma Convention (C, UShort_Array);
   pragma Convention (C, Int_Array);
   pragma Convention (C, UInt_Array);
   pragma Convention (C, Half_Array);
   pragma Convention (C, Single_Array);
   pragma Convention (C, Double_Array);

   type Size_Array is array (Size range <>) of aliased Size
     with Convention => C;

   --  Type descriptors
   type Numeric_Type is (Byte_Type, UByte_Type, Short_Type,
                         UShort_Type, Int_Type, UInt_Type,
                         Single_Type, Double_Type, Half_Type);
   type Signed_Numeric_Type is (Byte_Type, Short_Type, Int_Type,
                                Single_Type, Double_Type, Half_Type);
   type Unsigned_Numeric_Type is (UByte_Type, UShort_Type, UInt_Type);

   --  Doesn't really fit here, but there's no other place it fits better
   type Connection_Mode is (Points, Lines, Line_Loop, Line_Strip, Triangles,
                            Triangle_Strip, Triangle_Fan, Lines_Adjacency,
                            Line_Strip_Adjacency, Triangles_Adjacency,
                            Triangle_Strip_Adjacency, Patches);

   type Compare_Function is (Never, Less, Equal, LEqual, Greater, Not_Equal,
                             GEqual, Always);

   subtype Component_Count is Int range 1 .. 4;
   --  Counts the number of components for vertex attributes

   subtype Byte_Count is Int range 1 .. 4
     with Static_Predicate => Byte_Count in 1 | 2 | 4;
   --  Number of bytes of a component

   package Bytes is new GL.Algebra (Element_Type => Byte,
                                    Index_Type   => Size,
                                    Null_Value   => 0,
                                    One_Value    => 1);

   package Shorts is new GL.Algebra (Element_Type => Short,
                                     Index_Type   => Size,
                                     Null_Value   => 0,
                                     One_Value    => 1);

   package Ints is new GL.Algebra (Element_Type => Int,
                                   Index_Type   => Size,
                                   Null_Value   => 0,
                                   One_Value    => 1);

   package Longs is new GL.Algebra (Element_Type => Long,
                                    Index_Type   => Size,
                                    Null_Value   => 0,
                                    One_Value    => 1);

   package UBytes is new GL.Algebra (Element_Type => UByte,
                                     Index_Type   => Size,
                                     Null_Value   => 0,
                                     One_Value    => 1);

   package UShorts is new GL.Algebra (Element_Type => UShort,
                                      Index_Type   => Size,
                                      Null_Value   => 0,
                                      One_Value    => 1);

   package UInts is new GL.Algebra (Element_Type => UInt,
                                    Index_Type   => Size,
                                    Null_Value   => 0,
                                    One_Value    => 1);

   package Singles is new GL.Algebra (Element_Type => Single,
                                      Index_Type   => Size,
                                      Null_Value   => 0.0,
                                      One_Value    => 1.0);

   package Doubles is new GL.Algebra (Element_Type => Double,
                                      Index_Type   => Size,
                                      Null_Value   => 0.0,
                                      One_Value    => 1.0);

   --  Pointer types (for use with data transfer functions
   package Int_Pointers is new Interfaces.C.Pointers
     (Size, Int, Int_Array, Int'Last);

   package UInt_Pointers is new Interfaces.C.Pointers
     (Size, UInt, UInt_Array, UInt'Last);

   package Half_Pointers is new Interfaces.C.Pointers
     (Size, Half, Half_Array, 0);

   package Single_Pointers is new Interfaces.C.Pointers
     (Size, Single, Single_Array, 0.0);

   package Double_Pointers is new Interfaces.C.Pointers
     (Size, Double, Double_Array, 0.0);

   type String_Access is not null access constant String;

   type String_Array is array (Positive range <>) of String_Access;

private

   for Numeric_Type use (Byte_Type   => 16#1400#,
                         UByte_Type  => 16#1401#,
                         Short_Type  => 16#1402#,
                         UShort_Type => 16#1403#,
                         Int_Type    => 16#1404#,
                         UInt_Type   => 16#1405#,
                         Single_Type => 16#1406#,
                         Double_Type => 16#140A#,
                         Half_Type   => 16#140B#);
   for Numeric_Type'Size use UInt'Size;

   for Signed_Numeric_Type use (Byte_Type   => 16#1400#,
                                Short_Type  => 16#1402#,
                                Int_Type    => 16#1404#,
                                Single_Type => 16#1406#,
                                Double_Type => 16#140A#,
                                Half_Type   => 16#140B#);
   for Signed_Numeric_Type'Size use UInt'Size;

   for Unsigned_Numeric_Type use (UByte_Type  => 16#1401#,
                                  UShort_Type => 16#1403#,
                                  UInt_Type   => 16#1405#);
   for Unsigned_Numeric_Type'Size use UInt'Size;

   for Connection_Mode use (Points                   => 16#0000#,
                            Lines                    => 16#0001#,
                            Line_Loop                => 16#0002#,
                            Line_Strip               => 16#0003#,
                            Triangles                => 16#0004#,
                            Triangle_Strip           => 16#0005#,
                            Triangle_Fan             => 16#0006#,
                            Lines_Adjacency          => 16#000A#,
                            Line_Strip_Adjacency     => 16#000B#,
                            Triangles_Adjacency      => 16#000C#,
                            Triangle_Strip_Adjacency => 16#000D#,
                            Patches                  => 16#000E#);
   for Connection_Mode'Size use UInt'Size;

   for Compare_Function use (Never     => 16#0200#,
                             Less      => 16#0201#,
                             Equal     => 16#0202#,
                             LEqual    => 16#0203#,
                             Greater   => 16#0204#,
                             Not_Equal => 16#0205#,
                             GEqual    => 16#0206#,
                             Always    => 16#0207#);
   for Compare_Function'Size use UInt'Size;

end GL.Types;

--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with Interfaces.C.Extensions;
with Interfaces.C.Pointers;

with GL.Algebra;

package GL.Types is
   pragma Preelaborate;

   -- These are the types you can and should use with OpenGL functions
   -- (particularly when dealing with buffer objects).
   -- Types that are only used internally, but may be needed when interfacing
   -- with OpenGL-related library APIs can be found in GL.Low_Level.

   --  Signed integer types
   type Byte  is new C.signed_char;
   type Short is new C.short;
   type Int   is new C.int;
   type Long  is new C.Extensions.long_long;

   subtype Size is Int range 0 .. Int'Last;
   subtype Long_Size is Long range 0 .. Long'Last;

   --  Unsigned integer types
   type UByte  is new C.unsigned_char;
   type UShort is new C.unsigned_short;
   type UInt   is new C.unsigned;

   --  Floating point types ("Single" is used to avoid conflicts with Float)
   subtype Half is Short;  --  F16C extension can be used to convert from/to Single
   type Single is new C.C_float;
   type Double is new C.double;

   subtype Normalized_Single is Single range 0.0 .. 1.0;

   --  Array types
   type UByte_Array  is array (Size range <>) of aliased UByte;
   type UShort_Array is array (Size range <>) of aliased UShort;
   type Int_Array    is array (Size range <>) of aliased Int;
   type UInt_Array   is array (Size range <>) of aliased UInt;
   type Half_Array   is array (Size range <>) of aliased Half;
   type Single_Array is array (Size range <>) of aliased Single;
   type Double_Array is array (Size range <>) of aliased Double;

   pragma Convention (C, UByte_Array);
   pragma Convention (C, UShort_Array);
   pragma Convention (C, Int_Array);
   pragma Convention (C, UInt_Array);
   pragma Convention (C, Half_Array);
   pragma Convention (C, Single_Array);
   pragma Convention (C, Double_Array);

   type Size_Array is array (Size range <>) of aliased Size
     with Convention => C;

   --  Type descriptors
   type Numeric_Type is (Byte_Type, UByte_Type, Short_Type,
                         UShort_Type, Int_Type, UInt_Type,
                         Single_Type, Double_Type, Half_Type);
   type Signed_Numeric_Type is (Byte_Type, Short_Type, Int_Type,
                                Single_Type, Double_Type, Half_Type);
   type Unsigned_Numeric_Type is (UByte_Type, UShort_Type, UInt_Type);

   --  Doesn't really fit here, but there's no other place it fits better
   type Connection_Mode is (Points, Lines, Line_Loop, Line_Strip, Triangles,
                            Triangle_Strip, Triangle_Fan, Lines_Adjacency,
                            Line_Strip_Adjacency, Triangles_Adjacency,
                            Triangle_Strip_Adjacency, Patches);

   type Compare_Function is (Never, Less, Equal, LEqual, Greater, Not_Equal,
                             GEqual, Always);

   subtype Component_Count is Int range 1 .. 4;
   --  Counts the number of components for vertex attributes

   subtype Byte_Count is Int range 1 .. 4
     with Static_Predicate => Byte_Count in 1 | 2 | 4;
   --  Number of bytes of a component

   package Bytes is new GL.Algebra (Element_Type => Byte,
                                    Index_Type   => Size,
                                    Null_Value   => 0,
                                    One_Value    => 1);

   package Shorts is new GL.Algebra (Element_Type => Short,
                                     Index_Type   => Size,
                                     Null_Value   => 0,
                                     One_Value    => 1);

   package Ints is new GL.Algebra (Element_Type => Int,
                                   Index_Type   => Size,
                                   Null_Value   => 0,
                                   One_Value    => 1);

   package Longs is new GL.Algebra (Element_Type => Long,
                                    Index_Type   => Size,
                                    Null_Value   => 0,
                                    One_Value    => 1);

   package UBytes is new GL.Algebra (Element_Type => UByte,
                                     Index_Type   => Size,
                                     Null_Value   => 0,
                                     One_Value    => 1);

   package UShorts is new GL.Algebra (Element_Type => UShort,
                                      Index_Type   => Size,
                                      Null_Value   => 0,
                                      One_Value    => 1);

   package UInts is new GL.Algebra (Element_Type => UInt,
                                    Index_Type   => Size,
                                    Null_Value   => 0,
                                    One_Value    => 1);

   package Singles is new GL.Algebra (Element_Type => Single,
                                      Index_Type   => Size,
                                      Null_Value   => 0.0,
                                      One_Value    => 1.0);

   package Doubles is new GL.Algebra (Element_Type => Double,
                                      Index_Type   => Size,
                                      Null_Value   => 0.0,
                                      One_Value    => 1.0);

   --  Pointer types (for use with data transfer functions
   package UByte_Pointers is new Interfaces.C.Pointers
     (Size, UByte, UByte_Array, UByte'Last);

   package UShort_Pointers is new Interfaces.C.Pointers
     (Size, UShort, UShort_Array, UShort'Last);

   package Int_Pointers is new Interfaces.C.Pointers
     (Size, Int, Int_Array, Int'Last);

   package UInt_Pointers is new Interfaces.C.Pointers
     (Size, UInt, UInt_Array, UInt'Last);

   package Half_Pointers is new Interfaces.C.Pointers
     (Size, Half, Half_Array, 0);

   package Single_Pointers is new Interfaces.C.Pointers
     (Size, Single, Single_Array, 0.0);

   package Double_Pointers is new Interfaces.C.Pointers
     (Size, Double, Double_Array, 0.0);

   type String_Access is not null access constant String;

   type String_Array is array (Positive range <>) of String_Access;

private

   for Numeric_Type use (Byte_Type   => 16#1400#,
                         UByte_Type  => 16#1401#,
                         Short_Type  => 16#1402#,
                         UShort_Type => 16#1403#,
                         Int_Type    => 16#1404#,
                         UInt_Type   => 16#1405#,
                         Single_Type => 16#1406#,
                         Double_Type => 16#140A#,
                         Half_Type   => 16#140B#);
   for Numeric_Type'Size use UInt'Size;

   for Signed_Numeric_Type use (Byte_Type   => 16#1400#,
                                Short_Type  => 16#1402#,
                                Int_Type    => 16#1404#,
                                Single_Type => 16#1406#,
                                Double_Type => 16#140A#,
                                Half_Type   => 16#140B#);
   for Signed_Numeric_Type'Size use UInt'Size;

   for Unsigned_Numeric_Type use (UByte_Type  => 16#1401#,
                                  UShort_Type => 16#1403#,
                                  UInt_Type   => 16#1405#);
   for Unsigned_Numeric_Type'Size use UInt'Size;

   for Connection_Mode use (Points                   => 16#0000#,
                            Lines                    => 16#0001#,
                            Line_Loop                => 16#0002#,
                            Line_Strip               => 16#0003#,
                            Triangles                => 16#0004#,
                            Triangle_Strip           => 16#0005#,
                            Triangle_Fan             => 16#0006#,
                            Lines_Adjacency          => 16#000A#,
                            Line_Strip_Adjacency     => 16#000B#,
                            Triangles_Adjacency      => 16#000C#,
                            Triangle_Strip_Adjacency => 16#000D#,
                            Patches                  => 16#000E#);
   for Connection_Mode'Size use UInt'Size;

   for Compare_Function use (Never     => 16#0200#,
                             Less      => 16#0201#,
                             Equal     => 16#0202#,
                             LEqual    => 16#0203#,
                             Greater   => 16#0204#,
                             Not_Equal => 16#0205#,
                             GEqual    => 16#0206#,
                             Always    => 16#0207#);
   for Compare_Function'Size use UInt'Size;

end GL.Types;

gl: Add pointer types for types UByte and UShort

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  util-commands-drivers -- Support to make command line tools
--  Copyright (C) 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log.Loggers;
with Ada.Text_IO; use Ada.Text_IO;
package body Util.Commands.Drivers is

   use Ada.Strings.Unbounded;

   --  The logger
   Logs : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create (Driver_Name);

   --  ------------------------------
   --  Write the command usage.
   --  ------------------------------
   procedure Usage (Command : in Command_Type) is
   begin
      null;
   end Usage;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   --  ------------------------------
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Command.Driver.Log (Level, Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Print (Position : in Command_Maps.Cursor);

      procedure Print (Position : in Command_Maps.Cursor) is
         Name : constant String := Command_Maps.Key (Position);
      begin
         Put_Line ("   " & Name);
      end Print;

   begin
      Logs.Debug ("Execute command {0}", Name);

      if Args.Get_Count = 0 then
         Usage (Command.Driver.all, Args);
         New_Line;
         Put ("Type '");
         Put (Args.Get_Command_Name);
         Put_Line (" help {command}' for help on a specific command.");
         New_Line;
         Put_Line ("Available subcommands:");

         Command.Driver.List.Iterate (Process => Print'Access);
      else
         declare
            Cmd_Name   : constant String := Args.Get_Argument (1);
            Target_Cmd : constant Command_Access := Command.Driver.Find_Command (Cmd_Name);
         begin
            if Target_Cmd = null then
               Logs.Error ("Unknown command {0}", Cmd_Name);
            else
               Target_Cmd.Help (Context);
            end if;
         end;
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in Help_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

   --  ------------------------------
   --  Report the command usage.
   --  ------------------------------
   procedure Usage (Driver : in Driver_Type;
                    Args   : in Argument_List'Class) is
   begin
      Put_Line (To_String (Driver.Desc));
      New_Line;
      Put ("Usage: ");
      Put (Args.Get_Command_Name);
      Put (" ");
      Put_Line (To_String (Driver.Usage));
   end Usage;

   --  ------------------------------
   --  Set the driver description printed in the usage.
   --  ------------------------------
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String) is
   begin
      Driver.Desc := Ada.Strings.Unbounded.To_Unbounded_String (Description);
   end Set_Description;

   --  ------------------------------
   --  Set the driver usage printed in the usage.
   --  ------------------------------
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String) is
   begin
      Driver.Usage := Ada.Strings.Unbounded.To_Unbounded_String (Usage);
   end Set_Usage;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access) is
   begin
      Command.Driver := Driver'Unchecked_Access;
      Driver.List.Include (Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Handler : in Command_Handler) is
   begin
      Driver.List.Include (Name, new Handler_Command_Type '(Driver  => Driver'Unchecked_Access,
                                                            Handler => Handler));
   end Add_Command;

   --  ------------------------------
   --  Find the command having the given name.
   --  Returns null if the command was not found.
   --  ------------------------------
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access is
      Pos : constant Command_Maps.Cursor := Driver.List.Find (Name);
   begin
      if Command_Maps.Has_Element (Pos) then
         return Command_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Command;

   --  ------------------------------
   --  Execute the command registered under the given name.
   --  ------------------------------
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type) is
      Command : constant Command_Access := Driver.Find_Command (Name);
   begin
      if Command /= null then
         Command.Execute (Name, Args, Context);
      else
         Logs.Error ("Unkown command {0}", Name);
      end if;
   end Execute;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  ------------------------------
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
      pragma Unreferenced (Driver);
   begin
      Logs.Print (Level, "{0}: {1}", Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Handler (Name, Args, Context);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in Handler_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

end Util.Commands.Drivers;

-----------------------------------------------------------------------
--  util-commands-drivers -- Support to make command line tools
--  Copyright (C) 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log.Loggers;
with Ada.Text_IO; use Ada.Text_IO;
package body Util.Commands.Drivers is

   use Ada.Strings.Unbounded;

   --  The logger
   Logs : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create (Driver_Name);

   --  ------------------------------
   --  Write the command usage.
   --  ------------------------------
   procedure Usage (Command : in Command_Type) is
   begin
      null;
   end Usage;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   --  ------------------------------
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Command.Driver.Log (Level, Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Print (Position : in Command_Maps.Cursor);

      procedure Print (Position : in Command_Maps.Cursor) is
         Name : constant String := Command_Maps.Key (Position);
      begin
         Put_Line ("   " & Name);
      end Print;

   begin
      Logs.Debug ("Execute command {0}", Name);

      if Args.Get_Count = 0 then
         Usage (Command.Driver.all, Args);
         New_Line;
         Put ("Type '");
         Put (Args.Get_Command_Name);
         Put_Line (" help {command}' for help on a specific command.");
         New_Line;
         Put_Line ("Available subcommands:");

         Command.Driver.List.Iterate (Process => Print'Access);
      else
         declare
            Cmd_Name   : constant String := Args.Get_Argument (1);
            Target_Cmd : constant Command_Access := Command.Driver.Find_Command (Cmd_Name);
         begin
            if Target_Cmd = null then
               Logs.Error ("Unknown command {0}", Cmd_Name);
            else
               Target_Cmd.Help (Context);
            end if;
         end;
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in Help_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

   --  ------------------------------
   --  Report the command usage.
   --  ------------------------------
   procedure Usage (Driver : in Driver_Type;
                    Args   : in Argument_List'Class) is
   begin
      Put_Line (To_String (Driver.Desc));
      New_Line;
      Put ("Usage: ");
      Put (Args.Get_Command_Name);
      Put (" ");
      Put_Line (To_String (Driver.Usage));
   end Usage;

   --  ------------------------------
   --  Set the driver description printed in the usage.
   --  ------------------------------
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String) is
   begin
      Driver.Desc := Ada.Strings.Unbounded.To_Unbounded_String (Description);
   end Set_Description;

   --  ------------------------------
   --  Set the driver usage printed in the usage.
   --  ------------------------------
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String) is
   begin
      Driver.Usage := Ada.Strings.Unbounded.To_Unbounded_String (Usage);
   end Set_Usage;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access) is
   begin
      Command.Driver := Driver'Unchecked_Access;
      Driver.List.Include (Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Handler : in Command_Handler) is
   begin
      Driver.List.Include (Name, new Handler_Command_Type '(Driver  => Driver'Unchecked_Access,
                                                            Handler => Handler));
   end Add_Command;

   --  ------------------------------
   --  Find the command having the given name.
   --  Returns null if the command was not found.
   --  ------------------------------
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access is
      Pos : constant Command_Maps.Cursor := Driver.List.Find (Name);
   begin
      if Command_Maps.Has_Element (Pos) then
         return Command_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Command;

   --  ------------------------------
   --  Execute the command registered under the given name.
   --  ------------------------------
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type) is
      procedure Execute (Cmd_Args : in Argument_List'Class);

      Command : constant Command_Access := Driver.Find_Command (Name);

      procedure Execute (Cmd_Args : in Argument_List'Class) is
      begin
         Command.Execute (Name, Cmd_Args, Context);
      end Execute;

   begin
      if Command /= null then
         declare
            Config  : Config_Type;
         begin
            Command.Setup (Config);
            Config_Parser.Execute (Config, Args, Execute'Access);
         end;
      else
         Logs.Error ("Unkown command {0}", Name);
      end if;
   end Execute;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  ------------------------------
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
      pragma Unreferenced (Driver);
   begin
      Logs.Print (Level, "{0}: {1}", Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Handler (Name, Args, Context);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in Handler_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

end Util.Commands.Drivers;

Use the Config_Parser to parse the command arguments and then execute the command


-----------------------------------------------------------------------
--  util-serialize-io-csv -- CSV Serialization Driver
--  Copyright (C) 2011, 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Characters.Latin_1;
with Ada.IO_Exceptions;

with Util.Strings;
with Util.Dates.ISO8601;

package body Util.Serialize.IO.CSV is

   --  ------------------------------
   --  Write the value as a CSV cell.  Special characters are escaped using the CSV
   --  escape rules.
   --  ------------------------------
   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in String) is
   begin
      if Stream.Column > 1 then
         Stream.Write (",");
      end if;
      Stream.Column := Stream.Column + 1;
      Stream.Write ('"');
      for I in Value'Range loop
         if Value (I) = '"' then
            Stream.Write ("""""");
         else
            Stream.Write (Value (I));
         end if;
      end loop;
      Stream.Write ('"');
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Integer) is
   begin
      if Stream.Column > 1 then
         Stream.Write (",");
      end if;
      Stream.Column := Stream.Column + 1;
      Stream.Write (Util.Strings.Image (Value));
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Boolean) is
   begin
      if Stream.Column > 1 then
         Stream.Write (",");
      end if;
      Stream.Column := Stream.Column + 1;
      if Value then
         Stream.Write ("true");
      else
         Stream.Write ("false");
      end if;
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      case Util.Beans.Objects.Get_Type (Value) is
         when TYPE_NULL =>
            if Stream.Column > 1 then
               Stream.Write (",");
            end if;
            Stream.Column := Stream.Column + 1;
            Stream.Write ("""null""");

         when TYPE_BOOLEAN =>
            if Stream.Column > 1 then
               Stream.Write (",");
            end if;
            Stream.Column := Stream.Column + 1;
            if Util.Beans.Objects.To_Boolean (Value) then
               Stream.Write ("""true""");
            else
               Stream.Write ("""false""");
            end if;

         when TYPE_INTEGER =>
            if Stream.Column > 1 then
               Stream.Write (",");
            end if;
            Stream.Column := Stream.Column + 1;
            Stream.Write ('"');
            Stream.Write (Util.Beans.Objects.To_Long_Long_Integer (Value));
            Stream.Write ('"');

         when others =>
            Stream.Write_Cell (Util.Beans.Objects.To_String (Value));

      end case;
   end Write_Cell;

   --  ------------------------------
   --  Start a new row.
   --  ------------------------------
   procedure New_Row (Stream : in out Output_Stream) is
   begin
      while Stream.Column < Stream.Max_Columns loop
         Stream.Write (",");
         Stream.Column := Stream.Column + 1;
      end loop;
      Stream.Write (ASCII.CR);
      Stream.Write (ASCII.LF);
      Stream.Column := 1;
      Stream.Row := Stream.Row + 1;
   end New_Row;

   --  -----------------------
   --  Write the attribute name/value pair.
   --  -----------------------
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String) is
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer) is
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean) is
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object) is
   begin
      null;
   end Write_Attribute;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object) is
   begin
      null;
   end Write_Entity;

   --  -----------------------
   --  Write the entity value.
   --  -----------------------
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String) is
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean) is
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer) is
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time) is
   begin
      Stream.Write_Entity (Name, Util.Dates.ISO8601.Image (Value, Util.Dates.ISO8601.SUBSECOND));
   end Write_Entity;

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer) is
   begin
      null;
   end Write_Long_Entity;

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String) is
   begin
      Stream.Write_Entity (Name, Value);
   end Write_Enum_Entity;

   --  ------------------------------
   --  Get the header name for the given column.
   --  If there was no header line, build a default header for the column.
   --  ------------------------------
   function Get_Header_Name (Handler : in Parser;
                             Column  : in Column_Type) return String is
      use type Ada.Containers.Count_Type;

      Default_Header : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
      Result : String (1 .. 10);
      N, R   : Natural;
      Pos    : Positive := Result'Last;
   begin
      if Handler.Headers.Length >= Ada.Containers.Count_Type (Column) then
         return Handler.Headers.Element (Positive (Column));
      end if;
      N := Natural (Column - 1);
      loop
         R := N mod 26;
         N := N / 26;
         Result (Pos) := Default_Header (R + 1);
         exit when N = 0;
         Pos := Pos - 1;
      end loop;
      return Result (Pos .. Result'Last);
   end Get_Header_Name;

   --  ------------------------------
   --  Set the cell value at the given row and column.
   --  The default implementation finds the column header name and
   --  invokes Write_Entity with the header name and the value.
   --  ------------------------------
   procedure Set_Cell (Handler : in out Parser;
                       Value   : in String;
                       Row     : in Row_Type;
                       Column  : in Column_Type) is
      use Ada.Containers;
   begin
      if Row = 0 then
         --  Build the headers table.
         declare
            Missing : constant Integer := Integer (Column) - Integer (Handler.Headers.Length);
         begin
            if Missing > 0 then
               Handler.Headers.Set_Length (Handler.Headers.Length + Count_Type (Missing));
            end if;
            Handler.Headers.Replace_Element (Positive (Column), Value);
         end;
      else
         declare
            Name : constant String := Handler.Get_Header_Name (Column);
         begin
            --  Detect a new row.  Close the current object and start a new one.
            if Handler.Row /= Row then
               if Row > 1 then
                  Parser'Class (Handler).Finish_Object ("");
               end if;
               Parser'Class (Handler).Start_Object ("");
            end if;
            Handler.Row := Row;
            Parser'Class (Handler).Set_Member (Name, Util.Beans.Objects.To_Object (Value));
         end;
      end if;
   end Set_Cell;

   --  ------------------------------
   --  Set the field separator.  The default field separator is the comma (',').
   --  ------------------------------
   procedure Set_Field_Separator (Handler   : in out Parser;
                                  Separator : in Character) is
   begin
      Handler.Separator := Separator;
   end Set_Field_Separator;

   --  ------------------------------
   --  Get the field separator.
   --  ------------------------------
   function Get_Field_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Separator;
   end Get_Field_Separator;

   --  ------------------------------
   --  Set the comment separator.  When a comment separator is defined, a line which starts
   --  with the comment separator will be ignored.  The row number will not be incremented.
   --  ------------------------------
   procedure Set_Comment_Separator (Handler   : in out Parser;
                                    Separator : in Character) is
   begin
      Handler.Comment := Separator;
   end Set_Comment_Separator;

   --  ------------------------------
   --  Get the comment separator.  Returns ASCII.NUL if comments are not supported.
   --  ------------------------------
   function Get_Comment_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Comment;
   end Get_Comment_Separator;

   --  ------------------------------
   --  Setup the CSV parser and mapper to use the default column header names.
   --  When activated, the first row is assumed to contain the first item to de-serialize.
   --  ------------------------------
   procedure Set_Default_Headers (Handler : in out Parser;
                                  Mode    : in Boolean := True) is
   begin
      Handler.Use_Default_Headers := Mode;
   end Set_Default_Headers;

   --  ------------------------------
   --  Parse the stream using the CSV parser.
   --  Call Set_Cell for each cell that has been parsed indicating the row and
   --  column numbers as well as the cell value.
   --  ------------------------------
   overriding
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class) is
      use Ada.Strings.Unbounded;

      C              : Character;
      Token          : Unbounded_String;
      Column         : Column_Type := 1;
      Row            : Row_Type  := 0;
      In_Quote_Token : Boolean := False;
      In_Escape      : Boolean := False;
      Ignore_Row     : Boolean := False;
      Context        : Element_Context_Access;
   begin
      Context_Stack.Push (Handler.Stack);
      Context := Context_Stack.Current (Handler.Stack);
      Context.Active_Nodes (1) := Handler.Mapping_Tree'Unchecked_Access;
      if Handler.Use_Default_Headers then
         Row := 1;
      end if;
      Handler.Headers.Clear;
      loop
         Stream.Read (Char => C);

         if C = Ada.Characters.Latin_1.CR  or C = Ada.Characters.Latin_1.LF then
            if C = Ada.Characters.Latin_1.LF then
               Handler.Line_Number := Handler.Line_Number + 1;
            end if;
            if not Ignore_Row then
               if In_Quote_Token and not In_Escape then
                  Append (Token, C);

               elsif Column > 1 or else Length (Token) > 0 then
                  Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
                  Set_Unbounded_String (Token, "");
                  Row            := Row + 1;
                  Column         := 1;
                  In_Quote_Token := False;
                  In_Escape      := False;
               end if;
            else
               Ignore_Row := False;
            end if;

         elsif C = Handler.Separator and not Ignore_Row then
            if In_Quote_Token and not In_Escape then
               Append (Token, C);

            else
               Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
               Set_Unbounded_String (Token, "");
               Column         := Column + 1;
               In_Quote_Token := False;
               In_Escape      := False;
            end if;

         elsif C = '"' and not Ignore_Row then
            if In_Quote_Token then
               In_Escape := True;

            elsif In_Escape then
               Append (Token, C);
               In_Escape := False;

            elsif Ada.Strings.Unbounded.Length (Token) = 0 then
               In_Quote_Token := True;

            else
               Append (Token, C);
            end if;

         elsif C = Handler.Comment and Handler.Comment /= ASCII.NUL
           and Column = 1 and Length (Token) = 0
         then
            Ignore_Row := True;

         elsif not Ignore_Row then
            Append (Token, C);
            In_Escape := False;

         end if;

      end loop;

   exception
      when Ada.IO_Exceptions.Data_Error =>
         Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
         Context_Stack.Pop (Handler.Stack);
         return;
   end Parse;

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   overriding
   function Get_Location (Handler : in Parser) return String is
   begin
      return Util.Strings.Image (Handler.Line_Number);
   end Get_Location;

end Util.Serialize.IO.CSV;

-----------------------------------------------------------------------
--  util-serialize-io-csv -- CSV Serialization Driver
--  Copyright (C) 2011, 2015, 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Characters.Latin_1;
with Ada.IO_Exceptions;

with Util.Strings;
with Util.Dates.ISO8601;

package body Util.Serialize.IO.CSV is

   --  ------------------------------
   --  Write the value as a CSV cell.  Special characters are escaped using the CSV
   --  escape rules.
   --  ------------------------------
   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in String) is
   begin
      if Stream.Column > 1 then
         Stream.Write (",");
      end if;
      Stream.Column := Stream.Column + 1;
      Stream.Write ('"');
      for I in Value'Range loop
         if Value (I) = '"' then
            Stream.Write ("""""");
         else
            Stream.Write (Value (I));
         end if;
      end loop;
      Stream.Write ('"');
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Integer) is
   begin
      if Stream.Column > 1 then
         Stream.Write (",");
      end if;
      Stream.Column := Stream.Column + 1;
      Stream.Write (Util.Strings.Image (Value));
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Boolean) is
   begin
      if Stream.Column > 1 then
         Stream.Write (",");
      end if;
      Stream.Column := Stream.Column + 1;
      if Value then
         Stream.Write ("true");
      else
         Stream.Write ("false");
      end if;
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      case Util.Beans.Objects.Get_Type (Value) is
         when TYPE_NULL =>
            if Stream.Column > 1 then
               Stream.Write (",");
            end if;
            Stream.Column := Stream.Column + 1;
            Stream.Write ("""null""");

         when TYPE_BOOLEAN =>
            if Stream.Column > 1 then
               Stream.Write (",");
            end if;
            Stream.Column := Stream.Column + 1;
            if Util.Beans.Objects.To_Boolean (Value) then
               Stream.Write ("""true""");
            else
               Stream.Write ("""false""");
            end if;

         when TYPE_INTEGER =>
            if Stream.Column > 1 then
               Stream.Write (",");
            end if;
            Stream.Column := Stream.Column + 1;
            Stream.Write ('"');
            Stream.Write (Util.Beans.Objects.To_Long_Long_Integer (Value));
            Stream.Write ('"');

         when others =>
            Stream.Write_Cell (Util.Beans.Objects.To_String (Value));

      end case;
   end Write_Cell;

   --  ------------------------------
   --  Start a new row.
   --  ------------------------------
   procedure New_Row (Stream : in out Output_Stream) is
   begin
      while Stream.Column < Stream.Max_Columns loop
         Stream.Write (",");
         Stream.Column := Stream.Column + 1;
      end loop;
      Stream.Write (ASCII.CR);
      Stream.Write (ASCII.LF);
      Stream.Column := 1;
      Stream.Row := Stream.Row + 1;
   end New_Row;

   --  -----------------------
   --  Write the attribute name/value pair.
   --  -----------------------
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   --  -----------------------
   --  Write the entity value.
   --  -----------------------
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time) is
   begin
      Stream.Write_Entity (Name, Util.Dates.ISO8601.Image (Value, Util.Dates.ISO8601.SUBSECOND));
   end Write_Entity;

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer) is
   begin
      null;
   end Write_Long_Entity;

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String) is
   begin
      Stream.Write_Entity (Name, Value);
   end Write_Enum_Entity;

   --  ------------------------------
   --  Get the header name for the given column.
   --  If there was no header line, build a default header for the column.
   --  ------------------------------
   function Get_Header_Name (Handler : in Parser;
                             Column  : in Column_Type) return String is
      use type Ada.Containers.Count_Type;

      Default_Header : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
      Result : String (1 .. 10);
      N, R   : Natural;
      Pos    : Positive := Result'Last;
   begin
      if Handler.Headers.Length >= Ada.Containers.Count_Type (Column) then
         return Handler.Headers.Element (Positive (Column));
      end if;
      N := Natural (Column - 1);
      loop
         R := N mod 26;
         N := N / 26;
         Result (Pos) := Default_Header (R + 1);
         exit when N = 0;
         Pos := Pos - 1;
      end loop;
      return Result (Pos .. Result'Last);
   end Get_Header_Name;

   --  ------------------------------
   --  Set the cell value at the given row and column.
   --  The default implementation finds the column header name and
   --  invokes Write_Entity with the header name and the value.
   --  ------------------------------
   procedure Set_Cell (Handler : in out Parser;
                       Value   : in String;
                       Row     : in Row_Type;
                       Column  : in Column_Type) is
      use Ada.Containers;
   begin
      if Row = 0 then
         --  Build the headers table.
         declare
            Missing : constant Integer := Integer (Column) - Integer (Handler.Headers.Length);
         begin
            if Missing > 0 then
               Handler.Headers.Set_Length (Handler.Headers.Length + Count_Type (Missing));
            end if;
            Handler.Headers.Replace_Element (Positive (Column), Value);
         end;
      else
         declare
            Name : constant String := Handler.Get_Header_Name (Column);
         begin
            --  Detect a new row.  Close the current object and start a new one.
            if Handler.Row /= Row then
               if Row > 1 then
                  Parser'Class (Handler).Finish_Object ("");
               end if;
               Parser'Class (Handler).Start_Object ("");
            end if;
            Handler.Row := Row;
            Parser'Class (Handler).Set_Member (Name, Util.Beans.Objects.To_Object (Value));
         end;
      end if;
   end Set_Cell;

   --  ------------------------------
   --  Set the field separator.  The default field separator is the comma (',').
   --  ------------------------------
   procedure Set_Field_Separator (Handler   : in out Parser;
                                  Separator : in Character) is
   begin
      Handler.Separator := Separator;
   end Set_Field_Separator;

   --  ------------------------------
   --  Get the field separator.
   --  ------------------------------
   function Get_Field_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Separator;
   end Get_Field_Separator;

   --  ------------------------------
   --  Set the comment separator.  When a comment separator is defined, a line which starts
   --  with the comment separator will be ignored.  The row number will not be incremented.
   --  ------------------------------
   procedure Set_Comment_Separator (Handler   : in out Parser;
                                    Separator : in Character) is
   begin
      Handler.Comment := Separator;
   end Set_Comment_Separator;

   --  ------------------------------
   --  Get the comment separator.  Returns ASCII.NUL if comments are not supported.
   --  ------------------------------
   function Get_Comment_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Comment;
   end Get_Comment_Separator;

   --  ------------------------------
   --  Setup the CSV parser and mapper to use the default column header names.
   --  When activated, the first row is assumed to contain the first item to de-serialize.
   --  ------------------------------
   procedure Set_Default_Headers (Handler : in out Parser;
                                  Mode    : in Boolean := True) is
   begin
      Handler.Use_Default_Headers := Mode;
   end Set_Default_Headers;

   --  ------------------------------
   --  Parse the stream using the CSV parser.
   --  Call Set_Cell for each cell that has been parsed indicating the row and
   --  column numbers as well as the cell value.
   --  ------------------------------
   overriding
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class) is
      use Ada.Strings.Unbounded;

      C              : Character;
      Token          : Unbounded_String;
      Column         : Column_Type := 1;
      Row            : Row_Type  := 0;
      In_Quote_Token : Boolean := False;
      In_Escape      : Boolean := False;
      Ignore_Row     : Boolean := False;
      Context        : Element_Context_Access;
   begin
      Context_Stack.Push (Handler.Stack);
      Context := Context_Stack.Current (Handler.Stack);
      Context.Active_Nodes (1) := Handler.Mapping_Tree'Unchecked_Access;
      if Handler.Use_Default_Headers then
         Row := 1;
      end if;
      Handler.Headers.Clear;
      loop
         Stream.Read (Char => C);

         if C = Ada.Characters.Latin_1.CR  or C = Ada.Characters.Latin_1.LF then
            if C = Ada.Characters.Latin_1.LF then
               Handler.Line_Number := Handler.Line_Number + 1;
            end if;
            if not Ignore_Row then
               if In_Quote_Token and not In_Escape then
                  Append (Token, C);

               elsif Column > 1 or else Length (Token) > 0 then
                  Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
                  Set_Unbounded_String (Token, "");
                  Row            := Row + 1;
                  Column         := 1;
                  In_Quote_Token := False;
                  In_Escape      := False;
               end if;
            else
               Ignore_Row := False;
            end if;

         elsif C = Handler.Separator and not Ignore_Row then
            if In_Quote_Token and not In_Escape then
               Append (Token, C);

            else
               Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
               Set_Unbounded_String (Token, "");
               Column         := Column + 1;
               In_Quote_Token := False;
               In_Escape      := False;
            end if;

         elsif C = '"' and not Ignore_Row then
            if In_Quote_Token then
               In_Escape := True;

            elsif In_Escape then
               Append (Token, C);
               In_Escape := False;

            elsif Ada.Strings.Unbounded.Length (Token) = 0 then
               In_Quote_Token := True;

            else
               Append (Token, C);
            end if;

         elsif C = Handler.Comment and Handler.Comment /= ASCII.NUL
           and Column = 1 and Length (Token) = 0
         then
            Ignore_Row := True;

         elsif not Ignore_Row then
            Append (Token, C);
            In_Escape := False;

         end if;

      end loop;

   exception
      when Ada.IO_Exceptions.Data_Error =>
         Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
         Context_Stack.Pop (Handler.Stack);
         return;
   end Parse;

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   overriding
   function Get_Location (Handler : in Parser) return String is
   begin
      return Util.Strings.Image (Handler.Line_Number);
   end Get_Location;

end Util.Serialize.IO.CSV;

Add pragma Unreferenced to unused parameters


-----------------------------------------------------------------------
--  asf_volume_server -- The volume_server application with Ada Server Faces
--  Copyright (C) 2010, 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.IO_Exceptions;
with ASF.Server.Web;
with ASF.Servlets;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Measures;
with ASF.Filters.Dump;
with ASF.Beans;
with ASF.Applications;
with ASF.Applications.Main;
with ASF.Applications.Main.Configs;
with Util.Beans.Objects;
with Util.Log.Loggers;

with Countries;
with Volume;
with Messages;
procedure Asf_Volume_Server is

   CONTEXT_PATH : constant String := "/volume";
   CONFIG_PATH  : constant String := "samples.properties";

   Log     : Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Openid");

   Factory : ASF.Applications.Main.Application_Factory;
   App     : aliased ASF.Applications.Main.Application;
   Faces   : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files   : aliased ASF.Servlets.Files.File_Servlet;
   Perf    : aliased ASF.Servlets.Measures.Measure_Servlet;
   Dump    : aliased ASF.Filters.Dump.Dump_Filter;
   Bean    : aliased Volume.Compute_Bean;
   Conv    : aliased Volume.Float_Converter;
   WS      : ASF.Server.Web.AWS_Container;
   C       : ASF.Applications.Config;
   None    : ASF.Beans.Parameter_Bean_Ref.Ref;
begin
   C.Set (ASF.Applications.VIEW_EXT, ".html");
   C.Set (ASF.Applications.VIEW_DIR, "samples/web");
   C.Set ("web.dir", "samples/web");
   begin
      C.Load_Properties (CONFIG_PATH);

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot read application configuration file {0}", CONFIG_PATH);

   end;
   App.Initialize (C, Factory);
   App.Set_Global ("contextPath", CONTEXT_PATH);
   App.Set_Global ("compute",
                   Util.Beans.Objects.To_Object (Bean'Unchecked_Access,
                                                 Util.Beans.Objects.STATIC));

   App.Set_Global ("countries", Util.Beans.Objects.To_Object (Countries.Create_Country_List));

   --  Declare a global bean to identify this sample from within the XHTML files.
   App.Set_Global ("sampleName", "volume");

   --  Register the servlets and filters
   App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);
   App.Add_Filter (Name => "dump", Filter => Dump'Unchecked_Access);
   App.Add_Servlet (Name => "perf", Server => Perf'Unchecked_Access);
   App.Add_Filter (Name => "perf", Filter => Perf'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "faces", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Mapping (Name => "files", Pattern => "*.js");
   App.Add_Mapping (Name => "files", Pattern => "*.png");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.js");

   App.Add_Converter (Name => "float", Converter => Conv'Unchecked_Access);

   App.Register_Class (Name => "Message_Bean", Handler => Messages.Create_Message_Bean'Access);
   App.Register_Class (Name => "Message_List", Handler => Messages.Create_Message_List'Access);
   App.Register (Name => "message", Class => "Message_Bean", Params => None);
   App.Register (Name => "messages", Class => "Message_List", Params => None);

   ASF.Applications.Main.Configs.Read_Configuration (App, "samples/web/WEB-INF/web.xml");
   WS.Register_Application (CONTEXT_PATH, App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/volume/compute.html");
   WS.Start;

   delay 6000.0;

end Asf_Volume_Server;

-----------------------------------------------------------------------
--  asf_volume_server -- The volume_server application with Ada Server Faces
--  Copyright (C) 2010, 2011, 2012, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.IO_Exceptions;
with ASF.Server.Web;
with ASF.Servlets;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Measures;
with ASF.Filters.Dump;
with ASF.Beans;
with ASF.Applications;
with ASF.Applications.Main;
with ASF.Applications.Main.Configs;
with Util.Beans.Objects;
with Util.Log.Loggers;

with Countries;
with Volume;
with Messages;
procedure Asf_Volume_Server is

   CONTEXT_PATH : constant String := "/volume";
   CONFIG_PATH  : constant String := "samples.properties";

   Log     : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Openid");

   Factory : ASF.Applications.Main.Application_Factory;
   App     : aliased ASF.Applications.Main.Application;
   Faces   : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files   : aliased ASF.Servlets.Files.File_Servlet;
   Perf    : aliased ASF.Servlets.Measures.Measure_Servlet;
   Dump    : aliased ASF.Filters.Dump.Dump_Filter;
   Bean    : aliased Volume.Compute_Bean;
   Conv    : aliased Volume.Float_Converter;
   WS      : ASF.Server.Web.AWS_Container;
   C       : ASF.Applications.Config;
   None    : ASF.Beans.Parameter_Bean_Ref.Ref;
begin
   C.Set (ASF.Applications.VIEW_EXT, ".html");
   C.Set (ASF.Applications.VIEW_DIR, "samples/web");
   C.Set ("web.dir", "samples/web");
   begin
      C.Load_Properties (CONFIG_PATH);

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot read application configuration file {0}", CONFIG_PATH);

   end;
   App.Initialize (C, Factory);
   App.Set_Global ("contextPath", CONTEXT_PATH);
   App.Set_Global ("compute",
                   Util.Beans.Objects.To_Object (Bean'Unchecked_Access,
                                                 Util.Beans.Objects.STATIC));

   App.Set_Global ("countries", Util.Beans.Objects.To_Object (Countries.Create_Country_List));

   --  Declare a global bean to identify this sample from within the XHTML files.
   App.Set_Global ("sampleName", "volume");

   --  Register the servlets and filters
   App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);
   App.Add_Filter (Name => "dump", Filter => Dump'Unchecked_Access);
   App.Add_Servlet (Name => "perf", Server => Perf'Unchecked_Access);
   App.Add_Filter (Name => "perf", Filter => Perf'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "faces", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Mapping (Name => "files", Pattern => "*.js");
   App.Add_Mapping (Name => "files", Pattern => "*.png");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.js");

   App.Add_Converter (Name => "float", Converter => Conv'Unchecked_Access);

   App.Register_Class (Name => "Message_Bean", Handler => Messages.Create_Message_Bean'Access);
   App.Register_Class (Name => "Message_List", Handler => Messages.Create_Message_List'Access);
   App.Register (Name => "message", Class => "Message_Bean", Params => None);
   App.Register (Name => "messages", Class => "Message_List", Params => None);

   ASF.Applications.Main.Configs.Read_Configuration (App, "samples/web/WEB-INF/web.xml");
   WS.Register_Application (CONTEXT_PATH, App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/volume/compute.html");
   WS.Start;

   delay 6000.0;

end Asf_Volume_Server;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  awa-counters-components -- Counter UI component
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with ASF.Factory;
with ASF.Contexts.Faces;
with ASF.Components.Html;

--  == Counter Component ==
--
package AWA.Counters.Components is

   type UICounter is new ASF.Components.Html.UIHtmlComponent with private;

   --  Render the counter component.  Starts the DL/DD list and write the input
   --  component with the possible associated error message.
   overriding
   procedure Encode_Begin (UI      : in UICounter;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  Get the AWA Counter component factory.
   function Definition return ASF.Factory.Factory_Bindings_Access;

private

   type UICounter is new ASF.Components.Html.UIHtmlComponent with null record;

end AWA.Counters.Components;

-----------------------------------------------------------------------
--  awa-counters-components -- Counter UI component
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with ASF.Factory;
with ASF.Contexts.Faces;
with ASF.Components.Html;

--  == Counter Component ==
--
package AWA.Counters.Components is

   type UICounter is new ASF.Components.Html.UIHtmlComponent with private;

   --  Check if the counter value is hidden.
   function Is_Hidden (UI      : in UICounter;
                       Context : in ASF.Contexts.Faces.Faces_Context'Class) return Boolean;

   --  Render the counter component.  Starts the DL/DD list and write the input
   --  component with the possible associated error message.
   overriding
   procedure Encode_Begin (UI      : in UICounter;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  Get the AWA Counter component factory.
   function Definition return ASF.Factory.Factory_Bindings_Access;

private

   type UICounter is new ASF.Components.Html.UIHtmlComponent with null record;

end AWA.Counters.Components;

Declare the Is_Hidden function

Declare the Is_Hidden function


-----------------------------------------------------------------------
--  ado-drivers-tests -- Unit tests for database drivers
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Tests;
package ADO.Drivers.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   --  Test the Get_Config operation.
   procedure Test_Get_Config (T : in out Test);

   --  Test the Get_Driver operation.
   procedure Test_Get_Driver (T : in out Test);

   --  Test loading some invalid database driver.
   procedure Test_Load_Invalid_Driver (T : in out Test);

   --  Test the Get_Driver_Index operation.
   procedure Test_Get_Driver_Index (T : in out Test);

   --  Test the Set_Connection procedure.
   procedure Test_Set_Connection (T : in out Test);

   --  Test the Set_Connection procedure with several error cases.
   procedure Test_Set_Connection_Error (T : in out Test);

end ADO.Drivers.Tests;

-----------------------------------------------------------------------
--  ado-drivers-tests -- Unit tests for database drivers
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Tests;
package ADO.Drivers.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   --  Test the Initialize operation.
   procedure Test_Initialize (T : in out Test);

   --  Test the Get_Config operation.
   procedure Test_Get_Config (T : in out Test);

   --  Test the Get_Driver operation.
   procedure Test_Get_Driver (T : in out Test);

   --  Test loading some invalid database driver.
   procedure Test_Load_Invalid_Driver (T : in out Test);

   --  Test the Get_Driver_Index operation.
   procedure Test_Get_Driver_Index (T : in out Test);

   --  Test the Set_Connection procedure.
   procedure Test_Set_Connection (T : in out Test);

   --  Test the Set_Connection procedure with several error cases.
   procedure Test_Set_Connection_Error (T : in out Test);

end ADO.Drivers.Tests;

Declare the Test_Initialize procedure

Declare the Test_Initialize procedure


-----------------------------------------------------------------------
--  gen-commands-generate -- Generate command for dynamo
--  Copyright (C) 2011, 2012, 2015, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with GNAT.Command_Line;

with Ada.Directories;
with Ada.Text_IO;
package body Gen.Commands.Generate is

   use GNAT.Command_Line;
   use Ada.Directories;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Args);

      File_Count   : Natural := 0;
   begin
      Generator.Read_Project ("dynamo.xml", True);
      Gen.Generator.Read_Mappings (Generator);

      --  Parse the command line for the --package option.
      loop
         case Getopt ("p: ? -package:") is
         when ASCII.NUL => exit;

         when '-' =>
            if Full_Switch = "-package" then
               Generator.Enable_Package_Generation (Parameter);
            end if;

         when 'p' =>
            Generator.Enable_Package_Generation (Parameter);

         when others =>
            null;
         end case;
      end loop;

      --  Read the model files.
      loop
         declare
            Model_File : constant String := Get_Argument;
         begin
            exit when Model_File'Length = 0;
            File_Count := File_Count + 1;
            if Ada.Directories.Exists (Model_File)
              and then Ada.Directories.Kind (Model_File) = Ada.Directories.Directory
            then
               Gen.Generator.Read_Models (Generator, Model_File);
            else
               Gen.Generator.Read_Model (Generator, Model_File, False);
            end if;
         end;
      end loop;

      if File_Count = 0 then
         Gen.Generator.Read_Models (Generator, "db");
      end if;

      --  Run the generation.
      Gen.Generator.Prepare (Generator);
      Gen.Generator.Generate_All (Generator);
      Gen.Generator.Finish (Generator);
      Generator.Save_Project;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("generate: Generate the Ada files for the database model or queries");
      Put_Line ("Usage: generate [--package NAME] [MODEL ...]");
      New_Line;
      Put_Line ("  Read the XML/XMI model description (Hibernate mapping, query mapping, ...)");
      Put_Line ("  and generate the Ada model files that correspond to the mapping.");
      Put_Line ("  The --package option allows to generate only the package with the given name.");
      Put_Line ("  The default is to generate all the packages that are recognized.");
   end Help;

end Gen.Commands.Generate;

-----------------------------------------------------------------------
--  gen-commands-generate -- Generate command for dynamo
--  Copyright (C) 2011, 2012, 2015, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with GNAT.Command_Line;

with Ada.Directories;
with Ada.Text_IO;
package body Gen.Commands.Generate is

   use GNAT.Command_Line;
   use Ada.Directories;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Args);

      File_Count   : Natural := 0;
   begin
      Generator.Read_Project ("dynamo.xml", True);
      Gen.Generator.Read_Mappings (Generator);

      --  Parse the command line for the --package option.
      loop
         case Getopt ("p: ? -package:") is
         when ASCII.NUL => exit;

         when '-' =>
            if Full_Switch = "-package" then
               Generator.Enable_Package_Generation (Parameter);
            end if;

         when 'p' =>
            Generator.Enable_Package_Generation (Parameter);

         when others =>
            null;
         end case;
      end loop;

      --  Read the model files.
      loop
         declare
            Model_File : constant String := Get_Argument;
         begin
            exit when Model_File'Length = 0;
            File_Count := File_Count + 1;
            if Ada.Directories.Exists (Model_File)
              and then Ada.Directories.Kind (Model_File) = Ada.Directories.Directory
            then
               Gen.Generator.Read_Models (Generator, Model_File);
            else
               Gen.Generator.Read_Model (Generator, Model_File, False);
            end if;
         end;
      end loop;

      if File_Count = 0 then
         Gen.Generator.Read_Models (Generator, "db");
      end if;

      --  Run the generation.
      Gen.Generator.Prepare (Generator);
      Gen.Generator.Generate_All (Generator);
      Gen.Generator.Finish (Generator);
      Generator.Save_Project;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Name      : in String;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("generate: Generate the Ada files for the database model or queries");
      Put_Line ("Usage: generate [--package NAME] [MODEL ...]");
      New_Line;
      Put_Line ("  Read the XML/XMI model description (Hibernate mapping, query mapping, ...)");
      Put_Line ("  and generate the Ada model files that correspond to the mapping.");
      Put_Line ("  The --package option allows to generate only the package with the given name.");
      Put_Line ("  The default is to generate all the packages that are recognized.");
   end Help;

end Gen.Commands.Generate;

Add Name parameter to the Help procedure


-----------------------------------------------------------------------
--  mat-expressions -- Expressions for memory slot selection
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;

private with Util.Concurrent.Counters;

with MAT.Types;
with MAT.Memory;
package MAT.Expressions is

   type Context_Type is record
      Addr       : MAT.Types.Target_Addr;
      Allocation : MAT.Memory.Allocation;
   end record;

   type Kind_Type is (N_NOT, N_OR, N_AND, N_TRUE, N_FALSE,
                      N_IN_FILE, N_IN_FILE_DIRECT, N_INSIDE,
                      N_CALL_ADDR, N_CALL_ADDR_DIRECT,
                      N_IN_FUNC, N_IN_FUNC_DIRECT,
                      N_RANGE_SIZE, N_RANGE_ADDR,
                      N_CONDITION, N_THREAD);

   type Inside_Type is (INSIDE_FILE, INSIDE_FUNCTION);

   type Expression_Type is tagged private;

   --  Create a NOT expression node.
   function Create_Not (Expr : in Expression_Type) return Expression_Type;

   --  Create a AND expression node.
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type;

   --  Create a OR expression node.
   function Create_Or (Left  : in Expression_Type;
                       Right : in Expression_Type) return Expression_Type;

   --  Create an INSIDE expression node.
   function Create_Inside (Name : in String;
                           Kind : in Inside_Type) return Expression_Type;

   --  Create an size range expression node.
   function Create_Size (Min : in MAT.Types.Target_Size;
                         Max : in MAT.Types.Target_Size) return Expression_Type;

   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   function Is_Selected (Node    : in Expression_Type;
                         Context : in Context_Type) return Boolean;

private

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Kind_Type) is record
      Ref_Counter : Util.Concurrent.Counters.Counter;
      case Kind is
         when N_NOT =>
            Expr : Node_Type_Access;

         when N_OR | N_AND =>
            Left, Right : Node_Type_Access;

         when N_INSIDE | N_IN_FILE | N_IN_FILE_DIRECT | N_IN_FUNC | N_IN_FUNC_DIRECT =>
            Name   : Ada.Strings.Unbounded.Unbounded_String;
            Inside : Inside_Type;

         when N_RANGE_SIZE =>
            Min_Size : MAT.Types.Target_Size;
            Max_Size : MAT.Types.Target_Size;

         when N_RANGE_ADDR | N_CALL_ADDR | N_CALL_ADDR_DIRECT =>
            Min_Addr : MAT.Types.Target_Addr;
            Max_Addr : MAT.Types.Target_Addr;

         when N_THREAD =>
            Thread : MAT.Types.Target_Thread_Ref;

         when others =>
            null;
      end case;
   end record;

   function Is_Selected (Node    : in Node_Type;
                         Context : in Context_Type) return Boolean;

   type Expression_Type is tagged record
      Node : Node_Type_Access;
   end record;

end MAT.Expressions;

-----------------------------------------------------------------------
--  mat-expressions -- Expressions for memory slot selection
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;

private with Util.Concurrent.Counters;

with MAT.Types;
with MAT.Memory;
package MAT.Expressions is

   type Context_Type is record
      Addr       : MAT.Types.Target_Addr;
      Allocation : MAT.Memory.Allocation;
   end record;

   type Kind_Type is (N_NOT, N_OR, N_AND, N_TRUE, N_FALSE,
                      N_IN_FILE, N_IN_FILE_DIRECT, N_INSIDE,
                      N_CALL_ADDR, N_CALL_ADDR_DIRECT,
                      N_IN_FUNC, N_IN_FUNC_DIRECT,
                      N_RANGE_SIZE, N_RANGE_ADDR,
                      N_CONDITION, N_THREAD);

   type Inside_Type is (INSIDE_FILE, INSIDE_FUNCTION);

   type Expression_Type is tagged private;

   --  Create a NOT expression node.
   function Create_Not (Expr : in Expression_Type) return Expression_Type;

   --  Create a AND expression node.
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type;

   --  Create a OR expression node.
   function Create_Or (Left  : in Expression_Type;
                       Right : in Expression_Type) return Expression_Type;

   --  Create an INSIDE expression node.
   function Create_Inside (Name : in String;
                           Kind : in Inside_Type) return Expression_Type;

   --  Create an size range expression node.
   function Create_Size (Min : in MAT.Types.Target_Size;
                         Max : in MAT.Types.Target_Size) return Expression_Type;

   --  Create an addr range expression node.
   function Create_Addr (Min : in MAT.Types.Target_Addr;
                         Max : in MAT.Types.Target_Addr) return Expression_Type;

   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   function Is_Selected (Node    : in Expression_Type;
                         Context : in Context_Type) return Boolean;

private

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Kind_Type) is record
      Ref_Counter : Util.Concurrent.Counters.Counter;
      case Kind is
         when N_NOT =>
            Expr : Node_Type_Access;

         when N_OR | N_AND =>
            Left, Right : Node_Type_Access;

         when N_INSIDE | N_IN_FILE | N_IN_FILE_DIRECT | N_IN_FUNC | N_IN_FUNC_DIRECT =>
            Name   : Ada.Strings.Unbounded.Unbounded_String;
            Inside : Inside_Type;

         when N_RANGE_SIZE =>
            Min_Size : MAT.Types.Target_Size;
            Max_Size : MAT.Types.Target_Size;

         when N_RANGE_ADDR | N_CALL_ADDR | N_CALL_ADDR_DIRECT =>
            Min_Addr : MAT.Types.Target_Addr;
            Max_Addr : MAT.Types.Target_Addr;

         when N_THREAD =>
            Thread : MAT.Types.Target_Thread_Ref;

         when others =>
            null;
      end case;
   end record;

   function Is_Selected (Node    : in Node_Type;
                         Context : in Context_Type) return Boolean;

   type Expression_Type is tagged record
      Node : Node_Type_Access;
   end record;

end MAT.Expressions;

Define the Create_Addr operation for memory address slot range checking