-- Lua
-- an Ada 2012 interface to Lua

-- Copyright (c) 2015, James Humphry

-- Permission is hereby granted, free of charge, to any person obtaining
-- a copy of this software and associated documentation files (the
-- "Software"), to deal in the Software without restriction, including
-- without limitation the rights to use, copy, modify, merge, publish,
-- distribute, sublicense, and/or sell copies of the Software, and to
-- permit persons to whom the Software is furnished to do so, subject to
-- the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

with Ada.Finalization;

private with System;
private with Interfaces.C;

package Lua is

   -- Types used by Lua

   subtype Lua_Number is Long_Float;
   subtype Lua_Integer is Long_Long_Integer;

   -- Enumerations

   type Thread_Status is (OK, YIELD, ERRRUN, ERRSYNTAX, ERRMEM, ERRGCMM, ERRERR);

   type Arith_Op is (OPADD, OPSUB, OPMUL, OPMOD, OPPOW, OPDIV, OPIDIV, OPBAND,
                     OPBOR, OPBXOR, OPSHL, OPSHR, OPUNM, OPBNOT);

   type Comparison_Op is (OPEQ, OPLT, OPLE);

   type GC_Inputs is (GCSTOP, GCRESTART, GCCOLLECT, GCCOUNT,
                      GCCOUNTB, GCSTEP, GCSETPAUSE, GCSETSTEPMUL, GCISRUNNING);
   for GC_Inputs use (GCSTOP => 0, GCRESTART => 1, GCCOLLECT => 2,
                      GCCOUNT => 3, GCCOUNTB => 4, GCSTEP => 5,
                      GCSETPAUSE => 6, GCSETSTEPMUL => 7, GCISRUNNING => 9);

   subtype GC_Op is GC_Inputs range GCSTOP..GCSTEP;
   subtype GC_Param is GC_Inputs range GCSETPAUSE..GCSETSTEPMUL;
   subtype GC_Queries is GC_Inputs range GCISRUNNING..GCISRUNNING;

   type Lua_Type is (TNONE, TNIL, TBOOLEAN, TLIGHTUSERDATA, TNUMBER, TSTRING,
                     TTABLE, TFUNCTION, TUSERDATA, TTHREAD, TNUMTAGS);

   type Lua_ChunkMode is (Binary, Text, Binary_and_Text);

   -- Exceptions

   -- Lua_Error is raised whenever there is a violation of a constraint
   -- imposed by the semantics of the Lua interface - for example, trying to
   -- retrieve a number from a non-numeric value on the stack or using a
   -- reference on a different Lua_State than it was created on.
   Lua_Error : exception;

   -- Special stack positions and the registry
   MaxStack : constant Integer
     with Import, Convention => C, Link_Name => "lua_conf_luai_maxstack";
   RegistryIndex : constant Integer
     with Import, Convention => C, Link_Name => "lua_conf_registry_index";
   RIDX_MainThread : constant Integer;
   RIDX_Globals : constant Integer;
   RIDX_Last : constant Integer;
   function UpvalueIndex (i : in Integer) return Integer;

   -- Basic state control
   type Lua_State is tagged limited private;
   type Lua_Thread;
   function Version (L : in Lua_State) return Long_Float;
   function Status (L : in Lua_State) return Thread_Status;
   function LoadString (L : in Lua_State;
                        S : in String) return Thread_Status;
   function LoadFile (L : in Lua_State;
                      Name : in String;
                      Mode : in Lua_ChunkMode := Binary_and_Text)
                      return Thread_Status;

   -- Calling, yielding and functions
   procedure Call (L : in Lua_State; nargs : in Integer; nresults : in Integer)
     with Inline, Pre => IsFunction(L, -nargs-1);
   procedure Call_Function (L : in Lua_State;
                            name : in String;
                            nargs : in Integer;
                            nresults : in Integer);
   function PCall (L : in Lua_State;
                   nargs : in Integer;
                   nresults : in Integer;
                   msgh : in Integer := 0)
                   return Thread_Status
     with Inline, Pre => IsFunction(L, -nargs-1);
   function PCall_Function (L : in Lua_State;
                            name : in String;
                            nargs : in Integer;
                            nresults : in Integer;
                            msgh : in Integer := 0)
                            return Thread_Status;
   type AdaFunction is access function (L : Lua_State'Class) return Natural;
   procedure Register(L : in Lua_State; name : in String; f : in AdaFunction);
   MultRet_Sentinel : constant Integer
     with Import, Convention => C, Link_Name => "lua_conf_multret";

   -- Pushing values to the stack
   procedure PushAdaClosure (L : in Lua_State; f : in AdaFunction; n : in Natural);
   procedure PushAdaFunction (L : in Lua_State; f : in AdaFunction);
   procedure PushBoolean (L : in  Lua_State; b : in Boolean);
   procedure PushInteger (L : in Lua_State; n : in Lua_Integer);
   procedure PushNil (L : in Lua_State);
   procedure PushNumber (L : in Lua_State; n : in Lua_Number);
   procedure PushString (L : in Lua_State; s : in String);
   function PushThread (L : in Lua_State) return Boolean;
   procedure PushThread (L : in Lua_State);
   function StringToNumber (L : in Lua_State; s : in String) return Boolean;

   -- Pulling values from the stack
   function ToAdaFunction (L : in Lua_State; index : in Integer) return AdaFunction;
   function ToBoolean (L : in Lua_State; index : in Integer) return Boolean;
   function ToInteger (L : in Lua_State; index : in Integer) return Lua_Integer;
   function ToNumber (L : in Lua_State; index : in Integer) return Lua_Number;
   function ToString (L : in Lua_State; index : in Integer) return String;
   function ToThread (L : in Lua_State; index : in Integer) return Lua_Thread;

   -- Operations on values
   procedure Arith (L : in Lua_State; op : in Arith_Op);
   function Compare (L : in Lua_State;
                     index1 : in Integer;
                     index2 : in Integer;
                     op : in Comparison_Op) return Boolean;
   procedure Len (L : in  Lua_State; index : Integer);
   function RawEqual (L : in Lua_State; index1, index2 : in Integer) return Boolean;
   function RawLen (L : in Lua_State; index : Integer) return Integer;

   -- Garbage Collector control
   procedure GC (L : in Lua_State; what : in GC_Op);
   function GC (L : in Lua_State; what : in GC_Param; data : in Integer)
                return Integer;
   function GC (L : in Lua_State) return Boolean;

   -- Stack manipulation and information
   function AbsIndex (L : in Lua_State; idx : in Integer) return Integer;
   function CheckStack (L : in Lua_State; n : in Integer) return Boolean;
   procedure Copy (L : in Lua_State; fromidx : in Integer; toidx : in Integer);
   function GetTop (L : in Lua_State) return Integer;
   procedure Insert (L : in Lua_State; index : in Integer);
   procedure Pop (L : in Lua_State; n : in Integer);
   procedure PushValue (L : in Lua_State; index : in Integer);
   procedure Remove (L : in Lua_State; index : in Integer);
   procedure Replace (L : in Lua_State; index : in Integer);
   procedure Rotate (L : in Lua_State; idx : in Integer; n : in Integer);
   procedure SetTop (L : in Lua_State; index : in Integer);

   -- Type information
   function IsAdaFunction (L : in Lua_State; index : in Integer) return Boolean;
   function IsBoolean (L : in Lua_State; index : in Integer) return Boolean;
   function IsCFunction (L : in Lua_State; index : in Integer) return Boolean;
   function IsFunction (L : in Lua_State; index : in Integer) return Boolean;
   function IsInteger (L : in Lua_State; index : in Integer) return Boolean;
   function IsLightuserdata (L : in Lua_State; index : in Integer) return Boolean;
   function IsNil (L : in Lua_State; index : in Integer) return Boolean;
   function IsNone (L : in Lua_State; index : in Integer) return Boolean;
   function IsNoneOrNil (L : in Lua_State; index : in Integer) return Boolean;
   function IsNumber (L : in Lua_State; index : in Integer) return Boolean;
   function IsString (L : in Lua_State; index : in Integer) return Boolean;
   function IsTable (L : in Lua_State; index : in Integer) return Boolean;
   function IsThread (L : in Lua_State; index : in Integer) return Boolean;
   function IsUserdata (L : in Lua_State; index : in Integer) return Boolean;
   function TypeInfo (L : in Lua_State; index : in Integer) return Lua_Type;
   function TypeName (L : in Lua_State; tp : in Lua_Type) return String;
   function TypeName (L : in Lua_State; index : in Integer) return String is
     (TypeName(L, Typeinfo(L, index)));
   function Userdata_Name (L : in Lua_State; index : in Integer) return String;

   -- Table manipulation
   procedure CreateTable (L : in Lua_State;
                          narr : in Integer := 0;
                          nrec : in Integer := 0);
   procedure NewTable (L : in Lua_State);
   function GetField (L : in Lua_State; index : in Integer; k : in String)
                      return Lua_Type with Inline, Pre => IsTable(L, index);
   procedure GetField (L : in Lua_State; index : in Integer; k : in String)
     with Inline, Pre => IsTable(L, index);
   function Geti (L : in Lua_State; index : in Integer; i : in Integer)
                  return Lua_Type with Inline, Pre => IsTable(L, index);
   procedure Geti (L : in Lua_State; index : in Integer; i : in Integer)
     with Inline, Pre => IsTable(L, index);
   function GetTable (L : in Lua_State; index : in Integer) return Lua_Type
     with Inline, Pre => IsTable(L, index);
   procedure GetTable (L : in Lua_State; index : in Integer)
     with Inline, Pre => IsTable(L, index);
   function Next (L : in Lua_State; index : in Integer) return Boolean;
   function RawGet (L : in Lua_State; index : in Integer) return Lua_Type
     with Inline, Pre => IsTable(L, index);
   procedure RawGet (L : in Lua_State; index : in Integer)
     with Inline, Pre => IsTable(L, index);
   function RawGeti (L : in Lua_State; index : in Integer; i : in Integer)
                     return Lua_Type with Inline, Pre => IsTable(L, index);
   procedure RawGeti (L : in Lua_State; index : in Integer; i : in Integer)
     with Inline, Pre => IsTable(L, index);
   procedure RawSet (L : in Lua_State; index : in Integer)
     with Inline, Pre => IsTable(L, index);
   procedure RawSeti (L : in Lua_State; index : in Integer; i : in Integer)
     with Inline, Pre => IsTable(L, index);
   procedure SetField (L : in Lua_State; index : in Integer; k : in String)
     with Inline, Pre => IsTable(L, index);
   procedure Seti (L : in Lua_State; index : in Integer; i : in Integer)
     with Inline, Pre => IsTable(L, index);
   procedure SetTable (L : in Lua_State; index : in Integer)
     with Inline, Pre => IsTable(L, index);

   -- Globals and metatables
   function GetGlobal (L : in Lua_State; name : in String) return Lua_Type;
   procedure GetGlobal (L : in Lua_State; name : in String);
   function GetMetatable (L : in Lua_State; index : in Integer) return Boolean;
   procedure GetMetatable (L : in Lua_State; index : in Integer);
   procedure PushGlobalTable (L : in Lua_State);
   procedure SetGlobal (L : in Lua_State; name : in String);
   procedure SetMetatable (L : in Lua_State; index : in Integer);

   -- Threads
   type Lua_Thread is new Lua_State with private;
   function IsYieldable (L : in Lua_State'Class) return Boolean;
   function NewThread (L : in Lua_State'Class) return Lua_Thread;
   function Resume(L : in Lua_State'Class; from : in Lua_State'Class; nargs : Integer)
     return Thread_Status;
   procedure XMove (from, to : in Lua_Thread; n : in Integer);
   procedure Yield (L : in Lua_State; nresults : Integer);

   -- References
   type Lua_Reference is tagged private;
   function Ref (L : in Lua_State'Class; t : in Integer := RegistryIndex)
                 return Lua_Reference;
   function Get (L : in Lua_State; R : Lua_Reference'Class) return Lua_Type;
   procedure Get (L : in Lua_State; R : Lua_Reference'Class);

private

   subtype void_ptr is System.Address;

   for Thread_Status use (OK => 0, YIELD => 1, ERRRUN => 2, ERRSYNTAX => 3,
                          ERRMEM => 4, ERRGCMM => 5, ERRERR => 6);

   for Arith_Op use (OPADD => 0, OPSUB => 1, OPMUL => 2, OPMOD => 3, OPPOW => 4,
                     OPDIV => 5, OPIDIV => 6, OPBAND => 7, OPBOR => 8,
                     OPBXOR => 9, OPSHL => 10, OPSHR => 11, OPUNM => 12,
                     OPBNOT => 13);

   for Comparison_Op use (OPEQ => 0, OPLT => 1, OPLE => 2);

   for Lua_Type use (TNONE => -1, TNIL => 0, TBOOLEAN => 1, TLIGHTUSERDATA => 2,
                     TNUMBER => 3, TSTRING => 4, TTABLE => 5, TFUNCTION => 6,
                     TUSERDATA => 7, TTHREAD => 8, TNUMTAGS => 9);

   RIDX_MainThread : constant Integer := 1;
   RIDX_Globals : constant Integer := 2;
   RIDX_Last : constant Integer := RIDX_Globals;

   type Lua_State is new Ada.Finalization.Limited_Controlled with
      record
         L : void_Ptr;
      end record;

   overriding procedure Initialize (Object : in out Lua_State);
   overriding procedure Finalize   (Object : in out Lua_State);

   -- Existing_State is a clone of State but without automatic initialization
   -- It is used internally when lua_State* are returned from the Lua library
   -- and we don't want to re-initialize them when turning them into the
   -- State record type.
   type Existing_State is new Lua_State with null record;
   overriding procedure Initialize (Object : in out Existing_State) is null;
   overriding procedure Finalize   (Object : in out Existing_State) is null;

   type Lua_Thread is new Existing_State with null record;

   -- Trampolines

   function CFunction_Trampoline (L : System.Address) return Interfaces.C.int
     with Convention => C;

   -- References

   type Lua_Reference_Value is
      record
         State : void_Ptr;
         Table : Interfaces.C.Int;
         Ref : Interfaces.C.Int;
         Count : Natural := 0;
      end record;

   type Lua_Reference_Value_Access is access Lua_Reference_Value;

   type Lua_Reference is
     new Ada.Finalization.Controlled with
      record
         E : Lua_Reference_Value_Access := null;
      end record;

   overriding procedure Initialize (Object : in out Lua_Reference) is null;
   overriding procedure Adjust (Object : in out Lua_Reference);
   overriding procedure Finalize (Object : in out Lua_Reference);

end Lua;

-- Lua
-- an Ada 2012 interface to Lua

-- Copyright (c) 2015, James Humphry

-- Permission is hereby granted, free of charge, to any person obtaining
-- a copy of this software and associated documentation files (the
-- "Software"), to deal in the Software without restriction, including
-- without limitation the rights to use, copy, modify, merge, publish,
-- distribute, sublicense, and/or sell copies of the Software, and to
-- permit persons to whom the Software is furnished to do so, subject to
-- the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

with Ada.Finalization;

private with System;
private with Interfaces.C;

package Lua is

   -- Types used by Lua

   subtype Lua_Number is Long_Float;
   subtype Lua_Integer is Long_Long_Integer;

   -- Enumerations

   type Thread_Status is (OK, YIELD, ERRRUN, ERRSYNTAX,
                          ERRMEM, ERRGCMM, ERRERR, ERRFILE);

   type Arith_Op is (OPADD, OPSUB, OPMUL, OPMOD, OPPOW, OPDIV, OPIDIV, OPBAND,
                     OPBOR, OPBXOR, OPSHL, OPSHR, OPUNM, OPBNOT);

   type Comparison_Op is (OPEQ, OPLT, OPLE);

   type GC_Inputs is (GCSTOP, GCRESTART, GCCOLLECT, GCCOUNT,
                      GCCOUNTB, GCSTEP, GCSETPAUSE, GCSETSTEPMUL, GCISRUNNING);
   for GC_Inputs use (GCSTOP => 0, GCRESTART => 1, GCCOLLECT => 2,
                      GCCOUNT => 3, GCCOUNTB => 4, GCSTEP => 5,
                      GCSETPAUSE => 6, GCSETSTEPMUL => 7, GCISRUNNING => 9);

   subtype GC_Op is GC_Inputs range GCSTOP..GCSTEP;
   subtype GC_Param is GC_Inputs range GCSETPAUSE..GCSETSTEPMUL;
   subtype GC_Queries is GC_Inputs range GCISRUNNING..GCISRUNNING;

   type Lua_Type is (TNONE, TNIL, TBOOLEAN, TLIGHTUSERDATA, TNUMBER, TSTRING,
                     TTABLE, TFUNCTION, TUSERDATA, TTHREAD, TNUMTAGS);

   type Lua_ChunkMode is (Binary, Text, Binary_and_Text);

   -- Exceptions

   -- Lua_Error is raised whenever there is a violation of a constraint
   -- imposed by the semantics of the Lua interface - for example, trying to
   -- retrieve a number from a non-numeric value on the stack or using a
   -- reference on a different Lua_State than it was created on.
   Lua_Error : exception;

   -- Special stack positions and the registry
   MaxStack : constant Integer
     with Import, Convention => C, Link_Name => "lua_conf_luai_maxstack";
   RegistryIndex : constant Integer
     with Import, Convention => C, Link_Name => "lua_conf_registry_index";
   RIDX_MainThread : constant Integer;
   RIDX_Globals : constant Integer;
   RIDX_Last : constant Integer;
   function UpvalueIndex (i : in Integer) return Integer;

   -- Basic state control
   type Lua_State is tagged limited private;
   type Lua_Thread;
   function Version (L : in Lua_State) return Long_Float;
   function Status (L : in Lua_State) return Thread_Status;
   function LoadString (L : in Lua_State;
                        S : in String) return Thread_Status;
   function LoadFile (L : in Lua_State;
                      Name : in String;
                      Mode : in Lua_ChunkMode := Binary_and_Text)
                      return Thread_Status;

   -- Calling, yielding and functions
   procedure Call (L : in Lua_State; nargs : in Integer; nresults : in Integer)
     with Inline, Pre => IsFunction(L, -nargs-1);
   procedure Call_Function (L : in Lua_State;
                            name : in String;
                            nargs : in Integer;
                            nresults : in Integer);
   function PCall (L : in Lua_State;
                   nargs : in Integer;
                   nresults : in Integer;
                   msgh : in Integer := 0)
                   return Thread_Status
     with Inline, Pre => IsFunction(L, -nargs-1);
   function PCall_Function (L : in Lua_State;
                            name : in String;
                            nargs : in Integer;
                            nresults : in Integer;
                            msgh : in Integer := 0)
                            return Thread_Status;
   type AdaFunction is access function (L : Lua_State'Class) return Natural;
   procedure Register(L : in Lua_State; name : in String; f : in AdaFunction);
   MultRet_Sentinel : constant Integer
     with Import, Convention => C, Link_Name => "lua_conf_multret";

   -- Pushing values to the stack
   procedure PushAdaClosure (L : in Lua_State; f : in AdaFunction; n : in Natural);
   procedure PushAdaFunction (L : in Lua_State; f : in AdaFunction);
   procedure PushBoolean (L : in  Lua_State; b : in Boolean);
   procedure PushInteger (L : in Lua_State; n : in Lua_Integer);
   procedure PushNil (L : in Lua_State);
   procedure PushNumber (L : in Lua_State; n : in Lua_Number);
   procedure PushString (L : in Lua_State; s : in String);
   function PushThread (L : in Lua_State) return Boolean;
   procedure PushThread (L : in Lua_State);
   function StringToNumber (L : in Lua_State; s : in String) return Boolean;

   -- Pulling values from the stack
   function ToAdaFunction (L : in Lua_State; index : in Integer) return AdaFunction;
   function ToBoolean (L : in Lua_State; index : in Integer) return Boolean;
   function ToInteger (L : in Lua_State; index : in Integer) return Lua_Integer;
   function ToNumber (L : in Lua_State; index : in Integer) return Lua_Number;
   function ToString (L : in Lua_State; index : in Integer) return String;
   function ToThread (L : in Lua_State; index : in Integer) return Lua_Thread;

   -- Operations on values
   procedure Arith (L : in Lua_State; op : in Arith_Op);
   function Compare (L : in Lua_State;
                     index1 : in Integer;
                     index2 : in Integer;
                     op : in Comparison_Op) return Boolean;
   procedure Len (L : in  Lua_State; index : Integer);
   function RawEqual (L : in Lua_State; index1, index2 : in Integer) return Boolean;
   function RawLen (L : in Lua_State; index : Integer) return Integer;

   -- Garbage Collector control
   procedure GC (L : in Lua_State; what : in GC_Op);
   function GC (L : in Lua_State; what : in GC_Param; data : in Integer)
                return Integer;
   function GC (L : in Lua_State) return Boolean;

   -- Stack manipulation and information
   function AbsIndex (L : in Lua_State; idx : in Integer) return Integer;
   function CheckStack (L : in Lua_State; n : in Integer) return Boolean;
   procedure Copy (L : in Lua_State; fromidx : in Integer; toidx : in Integer);
   function GetTop (L : in Lua_State) return Integer;
   procedure Insert (L : in Lua_State; index : in Integer);
   procedure Pop (L : in Lua_State; n : in Integer);
   procedure PushValue (L : in Lua_State; index : in Integer);
   procedure Remove (L : in Lua_State; index : in Integer);
   procedure Replace (L : in Lua_State; index : in Integer);
   procedure Rotate (L : in Lua_State; idx : in Integer; n : in Integer);
   procedure SetTop (L : in Lua_State; index : in Integer);

   -- Type information
   function IsAdaFunction (L : in Lua_State; index : in Integer) return Boolean;
   function IsBoolean (L : in Lua_State; index : in Integer) return Boolean;
   function IsCFunction (L : in Lua_State; index : in Integer) return Boolean;
   function IsFunction (L : in Lua_State; index : in Integer) return Boolean;
   function IsInteger (L : in Lua_State; index : in Integer) return Boolean;
   function IsLightuserdata (L : in Lua_State; index : in Integer) return Boolean;
   function IsNil (L : in Lua_State; index : in Integer) return Boolean;
   function IsNone (L : in Lua_State; index : in Integer) return Boolean;
   function IsNoneOrNil (L : in Lua_State; index : in Integer) return Boolean;
   function IsNumber (L : in Lua_State; index : in Integer) return Boolean;
   function IsString (L : in Lua_State; index : in Integer) return Boolean;
   function IsTable (L : in Lua_State; index : in Integer) return Boolean;
   function IsThread (L : in Lua_State; index : in Integer) return Boolean;
   function IsUserdata (L : in Lua_State; index : in Integer) return Boolean;
   function TypeInfo (L : in Lua_State; index : in Integer) return Lua_Type;
   function TypeName (L : in Lua_State; tp : in Lua_Type) return String;
   function TypeName (L : in Lua_State; index : in Integer) return String is
     (TypeName(L, Typeinfo(L, index)));
   function Userdata_Name (L : in Lua_State; index : in Integer) return String;

   -- Table manipulation
   procedure CreateTable (L : in Lua_State;
                          narr : in Integer := 0;
                          nrec : in Integer := 0);
   procedure NewTable (L : in Lua_State);
   function GetField (L : in Lua_State; index : in Integer; k : in String)
                      return Lua_Type with Inline, Pre => IsTable(L, index);
   procedure GetField (L : in Lua_State; index : in Integer; k : in String)
     with Inline, Pre => IsTable(L, index);
   function Geti (L : in Lua_State; index : in Integer; i : in Integer)
                  return Lua_Type with Inline, Pre => IsTable(L, index);
   procedure Geti (L : in Lua_State; index : in Integer; i : in Integer)
     with Inline, Pre => IsTable(L, index);
   function GetTable (L : in Lua_State; index : in Integer) return Lua_Type
     with Inline, Pre => IsTable(L, index);
   procedure GetTable (L : in Lua_State; index : in Integer)
     with Inline, Pre => IsTable(L, index);
   function Next (L : in Lua_State; index : in Integer) return Boolean;
   function RawGet (L : in Lua_State; index : in Integer) return Lua_Type
     with Inline, Pre => IsTable(L, index);
   procedure RawGet (L : in Lua_State; index : in Integer)
     with Inline, Pre => IsTable(L, index);
   function RawGeti (L : in Lua_State; index : in Integer; i : in Integer)
                     return Lua_Type with Inline, Pre => IsTable(L, index);
   procedure RawGeti (L : in Lua_State; index : in Integer; i : in Integer)
     with Inline, Pre => IsTable(L, index);
   procedure RawSet (L : in Lua_State; index : in Integer)
     with Inline, Pre => IsTable(L, index);
   procedure RawSeti (L : in Lua_State; index : in Integer; i : in Integer)
     with Inline, Pre => IsTable(L, index);
   procedure SetField (L : in Lua_State; index : in Integer; k : in String)
     with Inline, Pre => IsTable(L, index);
   procedure Seti (L : in Lua_State; index : in Integer; i : in Integer)
     with Inline, Pre => IsTable(L, index);
   procedure SetTable (L : in Lua_State; index : in Integer)
     with Inline, Pre => IsTable(L, index);

   -- Globals and metatables
   function GetGlobal (L : in Lua_State; name : in String) return Lua_Type;
   procedure GetGlobal (L : in Lua_State; name : in String);
   function GetMetatable (L : in Lua_State; index : in Integer) return Boolean;
   procedure GetMetatable (L : in Lua_State; index : in Integer);
   procedure PushGlobalTable (L : in Lua_State);
   procedure SetGlobal (L : in Lua_State; name : in String);
   procedure SetMetatable (L : in Lua_State; index : in Integer);

   -- Threads
   type Lua_Thread is new Lua_State with private;
   function IsYieldable (L : in Lua_State'Class) return Boolean;
   function NewThread (L : in Lua_State'Class) return Lua_Thread;
   function Resume(L : in Lua_State'Class; from : in Lua_State'Class; nargs : Integer)
     return Thread_Status;
   procedure XMove (from, to : in Lua_Thread; n : in Integer);
   procedure Yield (L : in Lua_State; nresults : Integer);

   -- References
   type Lua_Reference is tagged private;
   function Ref (L : in Lua_State'Class; t : in Integer := RegistryIndex)
                 return Lua_Reference;
   function Get (L : in Lua_State; R : Lua_Reference'Class) return Lua_Type;
   procedure Get (L : in Lua_State; R : Lua_Reference'Class);

private

   subtype void_ptr is System.Address;

   for Thread_Status use (OK => 0, YIELD => 1, ERRRUN => 2, ERRSYNTAX => 3,
                          ERRMEM => 4, ERRGCMM => 5, ERRERR => 6, ERRFILE => 7);

   for Arith_Op use (OPADD => 0, OPSUB => 1, OPMUL => 2, OPMOD => 3, OPPOW => 4,
                     OPDIV => 5, OPIDIV => 6, OPBAND => 7, OPBOR => 8,
                     OPBXOR => 9, OPSHL => 10, OPSHR => 11, OPUNM => 12,
                     OPBNOT => 13);

   for Comparison_Op use (OPEQ => 0, OPLT => 1, OPLE => 2);

   for Lua_Type use (TNONE => -1, TNIL => 0, TBOOLEAN => 1, TLIGHTUSERDATA => 2,
                     TNUMBER => 3, TSTRING => 4, TTABLE => 5, TFUNCTION => 6,
                     TUSERDATA => 7, TTHREAD => 8, TNUMTAGS => 9);

   RIDX_MainThread : constant Integer := 1;
   RIDX_Globals : constant Integer := 2;
   RIDX_Last : constant Integer := RIDX_Globals;

   type Lua_State is new Ada.Finalization.Limited_Controlled with
      record
         L : void_Ptr;
      end record;

   overriding procedure Initialize (Object : in out Lua_State);
   overriding procedure Finalize   (Object : in out Lua_State);

   -- Existing_State is a clone of State but without automatic initialization
   -- It is used internally when lua_State* are returned from the Lua library
   -- and we don't want to re-initialize them when turning them into the
   -- State record type.
   type Existing_State is new Lua_State with null record;
   overriding procedure Initialize (Object : in out Existing_State) is null;
   overriding procedure Finalize   (Object : in out Existing_State) is null;

   type Lua_Thread is new Existing_State with null record;

   -- Trampolines

   function CFunction_Trampoline (L : System.Address) return Interfaces.C.int
     with Convention => C;

   -- References

   type Lua_Reference_Value is
      record
         State : void_Ptr;
         Table : Interfaces.C.Int;
         Ref : Interfaces.C.Int;
         Count : Natural := 0;
      end record;

   type Lua_Reference_Value_Access is access Lua_Reference_Value;

   type Lua_Reference is
     new Ada.Finalization.Controlled with
      record
         E : Lua_Reference_Value_Access := null;
      end record;

   overriding procedure Initialize (Object : in out Lua_Reference) is null;
   overriding procedure Adjust (Object : in out Lua_Reference);
   overriding procedure Finalize (Object : in out Lua_Reference);

end Lua;

Include ERRFILE in Thread_Status enumeration


-----------------------------------------------------------------------
--  awa-applications-configs -- Read application configuration files
--  Copyright (C) 2011, 2012, 2015, 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.Command_Line;
with Ada.Directories;
with Ada.Strings.Unbounded;

with Util.Files;
with Util.Log.Loggers;
with Util.Serialize.IO.XML;

with ASF.Contexts.Faces;
with ASF.Applications.Main.Configs;

with Security.Policies;
with AWA.Events.Configs;
with AWA.Services.Contexts;

package body AWA.Applications.Configs is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Applications.Configs");

   --  ------------------------------
   --  XML reader configuration.  By instantiating this generic package, the XML parser
   --  gets initialized to read the configuration for servlets, filters, managed beans,
   --  permissions, events and other configuration elements.
   --  ------------------------------
   package body Reader_Config is
      App_Access : constant ASF.Contexts.Faces.Application_Access := App.all'Unchecked_Access;

      package Bean_Config is
        new ASF.Applications.Main.Configs.Reader_Config (Mapper, App_Access,
                                                         Context.all'Access,
                                                         Override_Context);

      package Event_Config is
        new AWA.Events.Configs.Reader_Config (Mapper  => Mapper,
                                              Manager => App.Events'Unchecked_Access,
                                              Context => Context.all'Access);

      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Event_Config);
   end Reader_Config;

   --  ------------------------------
   --  Read the application configuration file and configure the application
   --  ------------------------------
   procedure Read_Configuration (App     : in out Application'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.Default.Default_Context_Access;
                                 Override_Context : in Boolean) is

      Reader : Util.Serialize.IO.XML.Parser;
      Mapper : Util.Serialize.Mappers.Processing;
      Ctx    : AWA.Services.Contexts.Service_Context;
      Sec    : constant Security.Policies.Policy_Manager_Access := App.Get_Security_Manager;
   begin
      Log.Info ("Reading application configuration file {0}", File);
      Ctx.Set_Context (App'Unchecked_Access, null);

      declare
         package Config is new Reader_Config (Mapper, App'Unchecked_Access, Context,
                                              Override_Context);
         pragma Warnings (Off, Config);
      begin
         Sec.Prepare_Config (Mapper);

         --  Initialize the parser with the module configuration mappers (if any).
         Initialize_Parser (App, Reader);

         if Log.Get_Level >= Util.Log.DEBUG_LEVEL then
            Util.Serialize.Mappers.Dump (Mapper, Log);
         end if;

         --  Read the configuration file and record managed beans, navigation rules.
         Reader.Parse (File, Mapper);
      end;
   exception
      when others =>
         Log.Error ("Error while reading {0}", File);
         raise;
   end Read_Configuration;

   --  ------------------------------
   --  Get the configuration path for the application name.
   --  The configuration path is search from:
   --  o the current directory,
   --  o the 'config' directory,
   --  o the Dynamo installation directory in share/dynamo
   --  ------------------------------
   function Get_Config_Path (Name : in String) return String is
      use Ada.Strings.Unbounded;
      use Ada.Directories;

      Command : constant String := Ada.Command_Line.Command_Name;
      Path    : constant String := Ada.Directories.Containing_Directory (Command);
      Dir     : constant String := Containing_Directory (Path);
      Paths   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Append (Paths, ".;");
      Append (Paths, Util.Files.Compose (Dir, "config"));
      Append (Paths, ";");
      Append (Paths, Util.Files.Compose (Dir, "share/dynamo/" & Name));
      return Util.Files.Find_File_Path (Name & ".properties", To_String (Paths));
   end Get_Config_Path;

end AWA.Applications.Configs;

-----------------------------------------------------------------------
--  awa-applications-configs -- Read application configuration files
--  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 Ada.Command_Line;
with Ada.Directories;
with Ada.Strings.Unbounded;

with Util.Files;
with Util.Log.Loggers;
with Util.Serialize.IO.XML;

with ASF.Contexts.Faces;
with ASF.Applications.Main.Configs;

with Security.Policies;
with AWA.Events.Configs.Reader_Config;
with AWA.Services.Contexts;

package body AWA.Applications.Configs is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Applications.Configs");

   --  ------------------------------
   --  XML reader configuration.  By instantiating this generic package, the XML parser
   --  gets initialized to read the configuration for servlets, filters, managed beans,
   --  permissions, events and other configuration elements.
   --  ------------------------------
   package body Reader_Config is
      App_Access : constant ASF.Contexts.Faces.Application_Access := App.all'Unchecked_Access;

      package Bean_Config is
        new ASF.Applications.Main.Configs.Reader_Config (Mapper, App_Access,
                                                         Context.all'Access,
                                                         Override_Context);

      package Event_Config is
        new AWA.Events.Configs.Reader_Config (Mapper  => Mapper,
                                              Manager => App.Events'Unchecked_Access,
                                              Context => Context.all'Access);

      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Event_Config);

   begin
      Event_Config.Initialize;
   end Reader_Config;

   --  ------------------------------
   --  Read the application configuration file and configure the application
   --  ------------------------------
   procedure Read_Configuration (App     : in out Application'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.Default.Default_Context_Access;
                                 Override_Context : in Boolean) is

      Reader : Util.Serialize.IO.XML.Parser;
      Mapper : Util.Serialize.Mappers.Processing;
      Ctx    : AWA.Services.Contexts.Service_Context;
      Sec    : constant Security.Policies.Policy_Manager_Access := App.Get_Security_Manager;
   begin
      Log.Info ("Reading application configuration file {0}", File);
      Ctx.Set_Context (App'Unchecked_Access, null);

      declare
         package Config is new Reader_Config (Mapper, App'Unchecked_Access, Context,
                                              Override_Context);
         pragma Warnings (Off, Config);
      begin
         Sec.Prepare_Config (Mapper);

         --  Initialize the parser with the module configuration mappers (if any).
         Initialize_Parser (App, Reader);

         if Log.Get_Level >= Util.Log.DEBUG_LEVEL then
            Util.Serialize.Mappers.Dump (Mapper, Log);
         end if;

         --  Read the configuration file and record managed beans, navigation rules.
         Reader.Parse (File, Mapper);
      end;
   exception
      when others =>
         Log.Error ("Error while reading {0}", File);
         raise;
   end Read_Configuration;

   --  ------------------------------
   --  Get the configuration path for the application name.
   --  The configuration path is search from:
   --  o the current directory,
   --  o the 'config' directory,
   --  o the Dynamo installation directory in share/dynamo
   --  ------------------------------
   function Get_Config_Path (Name : in String) return String is
      use Ada.Strings.Unbounded;
      use Ada.Directories;

      Command : constant String := Ada.Command_Line.Command_Name;
      Path    : constant String := Ada.Directories.Containing_Directory (Command);
      Dir     : constant String := Containing_Directory (Path);
      Paths   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Append (Paths, ".;");
      Append (Paths, Util.Files.Compose (Dir, "config"));
      Append (Paths, ";");
      Append (Paths, Util.Files.Compose (Dir, "share/dynamo/" & Name));
      return Util.Files.Find_File_Path (Name & ".properties", To_String (Paths));
   end Get_Config_Path;

end AWA.Applications.Configs;

Update to use the new Reader_Config package to read events configuration files


------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Smaz_Generic.Tools provides tools specific to the dictionary     --
-- implementation. These tools are useful for dictionary manipulation,      --
-- even though the intended use of this Smaz implementation is through a    --
-- global constant dictionary object.                                       --
------------------------------------------------------------------------------

with Ada.Containers;
with Natools.Smaz_Tools;

generic
package Natools.Smaz_Generic.Tools is
   pragma Preelaborate;

   package String_Lists renames Smaz_Tools.String_Lists;

   function To_Dictionary
     (List : in String_Lists.List;
      Variable_Length_Verbatim : in Boolean)
     return Dictionary
     with Pre => String_Lists.Length (List) in 1 ..
                 Ada.Containers.Count_Type (Ada.Streams.Stream_Element'Last);
      --  Build a Dictionary object from a string list
      --  Note that Hash is set to a placeholder which unconditionnally
      --  raises Program_Error when called.

   function To_String_List (Dict : in Dictionary) return String_Lists.List;
      --  Convert a dictionary back to the corresponding list of words

   generic
      with procedure Put_Line (Line : String);
   procedure Print_Dictionary_In_Ada
     (Dict : in Dictionary;
      Hash_Image : in String := "TODO";
      Max_Width : in Positive := 70;
      First_Prefix : in String := "     := (";
      Prefix : in String := "         ";
      Half_Indent : in String := "   ");
      --  Output Ada code corresponding to the value of the dictionary.
      --  Note that Prefix is the actual base indentation, while Half_Indent
      --  is added beyond Prefix before values continued on another line.
      --  Frist_Prefix is used instead of Prefix on the first line.
      --  All the defaults value are what was used to generate the constant
      --  in Natools.Smaz_Original.

   function Remove_Element
     (Dict : in Dictionary;
      Index : in Dictionary_Code)
     return Dictionary
     with Pre => Index <= Dict.Last_Code,
         Post => Dict.Last_Code = Dictionary_Code'Succ
                                    (Remove_Element'Result.Last_Code)
               and then (Index = Dictionary_Code'First
                  or else (for all I in Dictionary_Code'First
                                     .. Dictionary_Code'Pred (Index)
                     => Dict_Entry (Dict, I)
                        = Dict_Entry (Remove_Element'Result, I)))
               and then (Index = Dict.Last_Code
                  or else (for all I in Index
                                     .. Dictionary_Code'Pred (Dict.Last_Code)
                    => Dict_Entry (Dict, Dictionary_Code'Succ (I))
                       = Dict_Entry (Remove_Element'Result, I)));
      --  Return a new dictionary equal to Dict without element for Index

   function Append_String
     (Dict : in Dictionary;
      Value : in String)
     return Dictionary
     with Pre => Dict.Last_Code < Dictionary_Code'Last
               and then Value'Length > 0,
         Post => Dict.Last_Code = Dictionary_Code'Pred
                                    (Append_String'Result.Last_Code)
               and then (for all I in Dictionary_Code'First .. Dict.Last_Code
                  => Dict_Entry (Dict, I)
                     = Dict_Entry (Append_String'Result, I))
               and then Dict_Entry (Append_String'Result,
                                    Append_String'Result.Last_Code)
                        = Value;
      --  Return a new dictionary with Value appended

   type Dictionary_Counts is
     array (Dictionary_Code) of Smaz_Tools.String_Count;

   procedure Evaluate_Dictionary
     (Dict : in Dictionary;
      Corpus : in String_Lists.List;
      Compressed_Size : out Ada.Streams.Stream_Element_Count;
      Counts : out Dictionary_Counts);
   procedure Evaluate_Dictionary_Partial
     (Dict : in Dictionary;
      Corpus_Entry : in String;
      Compressed_Size : in out Ada.Streams.Stream_Element_Count;
      Counts : in out Dictionary_Counts);
      --  Compress all strings of Corpus, returning the total number of
      --  compressed bytes and the number of uses for each dictionary
      --  element.

   function Worst_Index
     (Dict : in Dictionary;
      Counts : in Dictionary_Counts;
      Method : in Smaz_Tools.Methods.Enum)
     return Dictionary_Code;
      --  Return the element with worst score

   function Score_Encoded
     (Dict : in Dictionary;
      Counts : in Dictionary_Counts;
      E : in Dictionary_Code)
     return Smaz_Tools.Score_Value
     is (Smaz_Tools.Score_Encoded (Counts (E), Dict_Entry_Length (Dict, E)));
      --  Score value using the amount of encoded data using E

   function Score_Frequency
     (Dict : in Dictionary;
      Counts : in Dictionary_Counts;
      E : in Dictionary_Code)
     return Smaz_Tools.Score_Value
     is (Smaz_Tools.Score_Frequency (Counts (E), Dict_Entry_Length (Dict, E)));
      --  Score value using the number of times E was used

   function Score_Gain
     (Dict : in Dictionary;
      Counts : in Dictionary_Counts;
      E : in Dictionary_Code)
     return Smaz_Tools.Score_Value
     is (Smaz_Tools.Score_Gain (Counts (E), Dict_Entry_Length (Dict, E)));
      --  Score value using the number of bytes saved using E

   function Score
     (Dict : in Dictionary;
      Counts : in Dictionary_Counts;
      E : in Dictionary_Code;
      Method : in Smaz_Tools.Methods.Enum)
     return Smaz_Tools.Score_Value
     is (Smaz_Tools.Score (Counts (E), Dict_Entry_Length (Dict, E), Method));
      --  Scare value with dynamically chosen method

end Natools.Smaz_Generic.Tools;

------------------------------------------------------------------------------
-- Copyright (c) 2016-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Smaz_Generic.Tools provides tools specific to the dictionary     --
-- implementation. These tools are useful for dictionary manipulation,      --
-- even though the intended use of this Smaz implementation is through a    --
-- global constant dictionary object.                                       --
------------------------------------------------------------------------------

with Natools.Smaz_Tools;

generic
package Natools.Smaz_Generic.Tools is
   pragma Preelaborate;

   package String_Lists renames Smaz_Tools.String_Lists;

   function To_Dictionary
     (List : in String_Lists.List;
      Variable_Length_Verbatim : in Boolean)
     return Dictionary
     with Pre => String_Lists.Length (List)
                 in 1 .. Dictionary_Code'Pos (Dictionary_Code'Last);
      --  Build a Dictionary object from a string list
      --  Note that Hash is set to a placeholder which unconditionnally
      --  raises Program_Error when called.

   function To_String_List (Dict : in Dictionary) return String_Lists.List;
      --  Convert a dictionary back to the corresponding list of words

   generic
      with procedure Put_Line (Line : String);
   procedure Print_Dictionary_In_Ada
     (Dict : in Dictionary;
      Hash_Image : in String := "TODO";
      Max_Width : in Positive := 70;
      First_Prefix : in String := "     := (";
      Prefix : in String := "         ";
      Half_Indent : in String := "   ");
      --  Output Ada code corresponding to the value of the dictionary.
      --  Note that Prefix is the actual base indentation, while Half_Indent
      --  is added beyond Prefix before values continued on another line.
      --  Frist_Prefix is used instead of Prefix on the first line.
      --  All the defaults value are what was used to generate the constant
      --  in Natools.Smaz_Original.

   function Remove_Element
     (Dict : in Dictionary;
      Index : in Dictionary_Code)
     return Dictionary
     with Pre => Index <= Dict.Last_Code,
         Post => Dict.Last_Code = Dictionary_Code'Succ
                                    (Remove_Element'Result.Last_Code)
               and then (Index = Dictionary_Code'First
                  or else (for all I in Dictionary_Code'First
                                     .. Dictionary_Code'Pred (Index)
                     => Dict_Entry (Dict, I)
                        = Dict_Entry (Remove_Element'Result, I)))
               and then (Index = Dict.Last_Code
                  or else (for all I in Index
                                     .. Dictionary_Code'Pred (Dict.Last_Code)
                    => Dict_Entry (Dict, Dictionary_Code'Succ (I))
                       = Dict_Entry (Remove_Element'Result, I)));
      --  Return a new dictionary equal to Dict without element for Index

   function Append_String
     (Dict : in Dictionary;
      Value : in String)
     return Dictionary
     with Pre => Dict.Last_Code < Dictionary_Code'Last
               and then Value'Length > 0,
         Post => Dict.Last_Code = Dictionary_Code'Pred
                                    (Append_String'Result.Last_Code)
               and then (for all I in Dictionary_Code'First .. Dict.Last_Code
                  => Dict_Entry (Dict, I)
                     = Dict_Entry (Append_String'Result, I))
               and then Dict_Entry (Append_String'Result,
                                    Append_String'Result.Last_Code)
                        = Value;
      --  Return a new dictionary with Value appended

   type Dictionary_Counts is
     array (Dictionary_Code) of Smaz_Tools.String_Count;

   procedure Evaluate_Dictionary
     (Dict : in Dictionary;
      Corpus : in String_Lists.List;
      Compressed_Size : out Ada.Streams.Stream_Element_Count;
      Counts : out Dictionary_Counts);
   procedure Evaluate_Dictionary_Partial
     (Dict : in Dictionary;
      Corpus_Entry : in String;
      Compressed_Size : in out Ada.Streams.Stream_Element_Count;
      Counts : in out Dictionary_Counts);
      --  Compress all strings of Corpus, returning the total number of
      --  compressed bytes and the number of uses for each dictionary
      --  element.

   function Worst_Index
     (Dict : in Dictionary;
      Counts : in Dictionary_Counts;
      Method : in Smaz_Tools.Methods.Enum)
     return Dictionary_Code;
      --  Return the element with worst score

   function Score_Encoded
     (Dict : in Dictionary;
      Counts : in Dictionary_Counts;
      E : in Dictionary_Code)
     return Smaz_Tools.Score_Value
     is (Smaz_Tools.Score_Encoded (Counts (E), Dict_Entry_Length (Dict, E)));
      --  Score value using the amount of encoded data using E

   function Score_Frequency
     (Dict : in Dictionary;
      Counts : in Dictionary_Counts;
      E : in Dictionary_Code)
     return Smaz_Tools.Score_Value
     is (Smaz_Tools.Score_Frequency (Counts (E), Dict_Entry_Length (Dict, E)));
      --  Score value using the number of times E was used

   function Score_Gain
     (Dict : in Dictionary;
      Counts : in Dictionary_Counts;
      E : in Dictionary_Code)
     return Smaz_Tools.Score_Value
     is (Smaz_Tools.Score_Gain (Counts (E), Dict_Entry_Length (Dict, E)));
      --  Score value using the number of bytes saved using E

   function Score
     (Dict : in Dictionary;
      Counts : in Dictionary_Counts;
      E : in Dictionary_Code;
      Method : in Smaz_Tools.Methods.Enum)
     return Smaz_Tools.Score_Value
     is (Smaz_Tools.Score (Counts (E), Dict_Entry_Length (Dict, E), Method));
      --  Scare value with dynamically chosen method

end Natools.Smaz_Generic.Tools;

fix the precondition of To_Dictionary

smaz_generic-tools: fix the precondition of To_Dictionary


-----------------------------------------------------------------------
--  util-systems-dlls -- Unix shared library support
--  Copyright (C) 2013 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 System;

with Interfaces.C;
with Util.Systems.Constants;

package Util.Systems.DLLs is

   --  The shared library handle.
   type Handle is private;

   Null_Handle : constant Handle;

   --  Exception raised when there is a problem loading a shared library.
   Load_Error : exception;

   --  Exception raised when a symbol cannot be found in a shared library.
   Not_Found  : exception;

   subtype Flags is Interfaces.C.int;

   --  Load the shared library with the given name or path and return a library handle.
   --  Raises the <tt>Load_Error</tt> exception if the library cannot be loaded.
   function Load (Path : in String;
                  Mode : in Flags := Util.Systems.Constants.RTLD_LAZY) return Handle;

   --  Unload the shared library.
   procedure Unload (Lib : in Handle);

   --  Get a global symbol with the given name in the library.
   --  Raises the <tt>Not_Found</tt> exception if the symbol does not exist.
   function Get_Symbol (Lib  : in Handle;
                        Name : in String) return System.Address;

private

   type Handle is new System.Address;

   Null_Handle : constant Handle := Handle (System.Null_Address);

end Util.Systems.DLLs;

-----------------------------------------------------------------------
--  util-systems-dlls -- Unix shared library support
--  Copyright (C) 2013 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 System;

with Interfaces.C;
with Util.Systems.Constants;

package Util.Systems.DLLs is

   --  The shared library handle.
   type Handle is private;

   Null_Handle : constant Handle;

   --  Exception raised when there is a problem loading a shared library.
   Load_Error : exception;

   --  Exception raised when a symbol cannot be found in a shared library.
   Not_Found  : exception;

   subtype Flags is Interfaces.C.int;

   Extension  : constant String := ".so";

   --  Load the shared library with the given name or path and return a library handle.
   --  Raises the <tt>Load_Error</tt> exception if the library cannot be loaded.
   function Load (Path : in String;
                  Mode : in Flags := Util.Systems.Constants.RTLD_LAZY) return Handle;

   --  Unload the shared library.
   procedure Unload (Lib : in Handle);

   --  Get a global symbol with the given name in the library.
   --  Raises the <tt>Not_Found</tt> exception if the symbol does not exist.
   function Get_Symbol (Lib  : in Handle;
                        Name : in String) return System.Address;

private

   type Handle is new System.Address;

   Null_Handle : constant Handle := Handle (System.Null_Address);

end Util.Systems.DLLs;

Define the extension for shared libraries


-----------------------------------------------------------------------
--  gen-commands-model -- Model creation command for dynamo
--  Copyright (C) 2011, 2012, 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.Text_IO;
with Ada.Command_Line;
with Gen.Artifacts;
with GNAT.Command_Line;

with Gen.Utils;
with Util.Files;
package body Gen.Commands.Model is

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

      Arg1     : constant String := (if Args.Get_Count > 0 then Args.Get_Argument (1) else "");
      Arg2     : constant String := (if Args.Get_Count > 1 then Args.Get_Argument (2) else "");
      Root_Dir : constant String := Generator.Get_Result_Directory;
      Dir      : constant String := Util.Files.Compose (Root_Dir, "db");
   begin
      if Args.Get_Count = 0 or Args.Get_Count > 2 then
         Gen.Commands.Usage;
         return;
      end if;

      Generator.Read_Project ("dynamo.xml");
      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Dir);
      if Args.Get_Count = 1 then
         --  Verify that we can use the name for an Ada identifier.
         if not Gen.Utils.Is_Valid_Name (Arg1) then
            Generator.Error ("The mapping name should be a valid Ada identifier.");
            raise Gen.Generator.Fatal_Error with "Invalid mapping name: " & Arg1;
         end if;
         Generator.Set_Global ("moduleName", "");
         Generator.Set_Global ("modelName", Arg1);
      else
         --  Verify that we can use the name for an Ada identifier.
         if not Gen.Utils.Is_Valid_Name (Arg1) then
            Generator.Error ("The module name should be a valid Ada identifier.");
            raise Gen.Generator.Fatal_Error with "Invalid module name: " & Arg1;
         end if;

         --  Likewise for the mapping name.
         if not Gen.Utils.Is_Valid_Name (Arg2) then
            Generator.Error ("The mapping name should be a valid Ada identifier.");
            raise Gen.Generator.Fatal_Error with "Invalid mapping name: " & Arg2;
         end if;
         Generator.Set_Global ("moduleName", Arg1);
         Generator.Set_Global ("modelName", Arg2);
      end if;
      Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "add-model");

      --  If the generation succeeds, run the generate command to generate the Ada files.
      if Generator.Get_Status = Ada.Command_Line.Success then

         Generator.Set_Result_Directory (Root_Dir);
         Generator.Set_Force_Save (True);
         Gen.Generator.Read_Models (Generator, "db");

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

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("add-model: Add a new database table model to the application");
      Put_Line ("Usage: add-model [MODULE] NAME");
      New_Line;
      Put_Line ("  The database table model is an XML file that describes the mapping");
      Put_Line ("  for of a database table to an Ada representation.");
      Put_Line ("  The XML description is similar to Hibernate mapping files.");
      Put_Line ("  (See http://docs.jboss.org/hibernate/core/3.6/"
                & "reference/en-US/html/mapping.html)");
      Put_Line ("  If a MODULE is specified, the Ada package will be: "
                & "<PROJECT>.<MODULE>.Model.<NAME>");
      Put_Line ("  Otherwise, the Ada package will be: <PROJECT>.Model.<NAME>");
   end Help;

end Gen.Commands.Model;

-----------------------------------------------------------------------
--  gen-commands-model -- Model creation command for dynamo
--  Copyright (C) 2011, 2012, 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.Text_IO;
with Ada.Command_Line;
with Gen.Artifacts;

with Gen.Utils;
with Util.Files;
package body Gen.Commands.Model is

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

      Arg1     : constant String := (if Args.Get_Count > 0 then Args.Get_Argument (1) else "");
      Arg2     : constant String := (if Args.Get_Count > 1 then Args.Get_Argument (2) else "");
      Root_Dir : constant String := Generator.Get_Result_Directory;
      Dir      : constant String := Util.Files.Compose (Root_Dir, "db");
   begin
      if Args.Get_Count = 0 or Args.Get_Count > 2 then
         Gen.Commands.Usage;
         return;
      end if;

      Generator.Read_Project ("dynamo.xml");
      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Dir);
      if Args.Get_Count = 1 then
         --  Verify that we can use the name for an Ada identifier.
         if not Gen.Utils.Is_Valid_Name (Arg1) then
            Generator.Error ("The mapping name should be a valid Ada identifier.");
            raise Gen.Generator.Fatal_Error with "Invalid mapping name: " & Arg1;
         end if;
         Generator.Set_Global ("moduleName", "");
         Generator.Set_Global ("modelName", Arg1);
      else
         --  Verify that we can use the name for an Ada identifier.
         if not Gen.Utils.Is_Valid_Name (Arg1) then
            Generator.Error ("The module name should be a valid Ada identifier.");
            raise Gen.Generator.Fatal_Error with "Invalid module name: " & Arg1;
         end if;

         --  Likewise for the mapping name.
         if not Gen.Utils.Is_Valid_Name (Arg2) then
            Generator.Error ("The mapping name should be a valid Ada identifier.");
            raise Gen.Generator.Fatal_Error with "Invalid mapping name: " & Arg2;
         end if;
         Generator.Set_Global ("moduleName", Arg1);
         Generator.Set_Global ("modelName", Arg2);
      end if;
      Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "add-model");

      --  If the generation succeeds, run the generate command to generate the Ada files.
      if Generator.Get_Status = Ada.Command_Line.Success then

         Generator.Set_Result_Directory (Root_Dir);
         Generator.Set_Force_Save (True);
         Gen.Generator.Read_Models (Generator, "db");

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

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("add-model: Add a new database table model to the application");
      Put_Line ("Usage: add-model [MODULE] NAME");
      New_Line;
      Put_Line ("  The database table model is an XML file that describes the mapping");
      Put_Line ("  for of a database table to an Ada representation.");
      Put_Line ("  The XML description is similar to Hibernate mapping files.");
      Put_Line ("  (See http://docs.jboss.org/hibernate/core/3.6/"
                & "reference/en-US/html/mapping.html)");
      Put_Line ("  If a MODULE is specified, the Ada package will be: "
                & "<PROJECT>.<MODULE>.Model.<NAME>");
      Put_Line ("  Otherwise, the Ada package will be: <PROJECT>.Model.<NAME>");
   end Help;

end Gen.Commands.Model;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  Appenders -- Log appenders
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 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.Text_IO;
with Ada.Strings.Unbounded;
with Ada.Calendar;
with Ada.Finalization;
with Util.Properties;
limited with Util.Log.Loggers;

--  The log Appender will handle the low level operations to write
--  the log content to a file, the console, a database.
package Util.Log.Appenders is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Log event
   --  ------------------------------
   --  The Log_Event represent a log message reported by one of the
   --  log operation (Debug, Info, Warn, Error).
   type Log_Event is record
      --  The log message (formatted)
      Message : Unbounded_String;

      --  The timestamp when the message was produced.
      Time    : Ada.Calendar.Time;

      --  The log level
      Level   : Level_Type;

      --  The logger
      Logger  : access Util.Log.Loggers.Logger_Info;
   end record;

   --  The layout type to indicate how to format the message.
   --  Unlike Logj4, there is no customizable layout.
   type Layout_Type
     is (
         --  The message layout with only the log message.
         --  Ex: "Cannot open file"
         MESSAGE,

         --  The level-message layout with level and message.
         --  Ex: "ERROR: Cannot open file"
         LEVEL_MESSAGE,

         --  The date-level-message layout with date
         --  Ex: "2011-03-04 12:13:34 ERROR: Cannot open file"
         DATE_LEVEL_MESSAGE,

         --  The full layout with everything (the default).
         --  Ex: "2011-03-04 12:13:34 ERROR - my.application - Cannot open file"
         FULL);

   --  ------------------------------
   --  Log appender
   --  ------------------------------
   type Appender is abstract new Ada.Finalization.Limited_Controlled with private;

   type Appender_Access is access all Appender'Class;

   --  Get the log level that triggers display of the log events
   function Get_Level (Self : in Appender) return Level_Type;

   --  Set the log level.
   procedure Set_Level (Self       : in out Appender;
                        Name       : in String;
                        Properties : in Util.Properties.Manager;
                        Level      : in Level_Type);

   --  Set the log layout format.
   procedure Set_Layout (Self       : in out Appender;
                         Name       : in String;
                         Properties : in Util.Properties.Manager;
                         Layout     : in Layout_Type);

   --  Format the event into a string
   function Format (Self  : in Appender;
                    Event : in Log_Event) return String;

   --  Append a log event to the appender.  Depending on the log level
   --  defined on the appender, the event can be taken into account or
   --  ignored.
   procedure Append (Self  : in out Appender;
                     Event : in Log_Event) is abstract;

   --  Flush the log events.
   procedure Flush (Self   : in out Appender) is abstract;

   --  ------------------------------
   --  File appender
   --  ------------------------------
   --  Write log events to a file
   type File_Appender is new Appender with private;
   type File_Appender_Access is access all File_Appender'Class;

   overriding
   procedure Append (Self  : in out File_Appender;
                     Event : in Log_Event);

   --  Set the file where the appender will write the logs.
   --  When <tt>Append</tt> is true, the log message are appended to the existing file.
   --  When set to false, the file is cleared before writing new messages.
   procedure Set_File (Self   : in out File_Appender;
                       Path   : in String;
                       Append : in Boolean := True);

   --  Flush the log events.
   overriding
   procedure Flush (Self   : in out File_Appender);

   --  Flush and close the file.
   overriding
   procedure Finalize (Self : in out File_Appender);

   --  Create a file appender and configure it according to the properties
   function Create_File_Appender (Name       : in String;
                                  Properties : in Util.Properties.Manager;
                                  Default    : in Level_Type)
     return Appender_Access;

   --  ------------------------------
   --  Console appender
   --  ------------------------------
   --  Write log events to the console
   type Console_Appender is new Appender with private;
   type Console_Appender_Access is access all Console_Appender'Class;

   overriding
   procedure Append (Self  : in out Console_Appender;
                     Event : in Log_Event);

   --  Flush the log events.
   overriding
   procedure Flush (Self   : in out Console_Appender);

   --  Create a console appender and configure it according to the properties
   function Create_Console_Appender (Name       : in String;
                                     Properties : in Util.Properties.Manager;
                                     Default    : in Level_Type)
                                     return Appender_Access;

   --  ------------------------------
   --  List appender
   --  ------------------------------
   --  Write log events to a list of appenders
   type List_Appender is new Appender with private;
   type List_Appender_Access is access all List_Appender'Class;

   --  Max number of appenders that can be added to the list.
   --  In most cases, 2 or 3 appenders will be used.
   MAX_APPENDERS : constant Natural := 10;

   overriding
   procedure Append (Self  : in out List_Appender;
                     Event : in Log_Event);

   --  Flush the log events.
   overriding
   procedure Flush (Self   : in out List_Appender);

   --  Add the appender to the list.
   procedure Add_Appender (Self   : in out List_Appender;
                           Object : in Appender_Access);

   --  Create a list appender and configure it according to the properties
   function Create_List_Appender return List_Appender_Access;

private

   type Appender is abstract new Ada.Finalization.Limited_Controlled with record
      Level    : Level_Type := INFO_LEVEL;
      Layout   : Layout_Type := FULL;
   end record;

   type File_Appender is new Appender with record
      Output          : Ada.Text_IO.File_Type;
      Immediate_Flush : Boolean := False;
   end record;

   type Appender_Array_Access is array (1 .. MAX_APPENDERS) of Appender_Access;

   type List_Appender is new Appender with record
      Appenders : Appender_Array_Access;
      Count     : Natural := 0;
   end record;

   type Console_Appender is new Appender with null record;

end Util.Log.Appenders;

-----------------------------------------------------------------------
--  util-log-appenders -- Log appenders
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2015, 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 Ada.Text_IO;
with Ada.Strings.Unbounded;
with Ada.Calendar;
with Ada.Finalization;
with Util.Properties;
limited with Util.Log.Loggers;

--  The log Appender will handle the low level operations to write
--  the log content to a file, the console, a database.
package Util.Log.Appenders is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Log event
   --  ------------------------------
   --  The Log_Event represent a log message reported by one of the
   --  log operation (Debug, Info, Warn, Error).
   type Log_Event is record
      --  The log message (formatted)
      Message : Unbounded_String;

      --  The timestamp when the message was produced.
      Time    : Ada.Calendar.Time;

      --  The log level
      Level   : Level_Type;

      --  The logger
      Logger  : access Util.Log.Loggers.Logger_Info;
   end record;

   --  The layout type to indicate how to format the message.
   --  Unlike Logj4, there is no customizable layout.
   type Layout_Type
     is (
         --  The message layout with only the log message.
         --  Ex: "Cannot open file"
         MESSAGE,

         --  The level-message layout with level and message.
         --  Ex: "ERROR: Cannot open file"
         LEVEL_MESSAGE,

         --  The date-level-message layout with date
         --  Ex: "2011-03-04 12:13:34 ERROR: Cannot open file"
         DATE_LEVEL_MESSAGE,

         --  The full layout with everything (the default).
         --  Ex: "2011-03-04 12:13:34 ERROR - my.application - Cannot open file"
         FULL);

   --  ------------------------------
   --  Log appender
   --  ------------------------------
   type Appender is abstract new Ada.Finalization.Limited_Controlled with private;

   type Appender_Access is access all Appender'Class;

   --  Get the log level that triggers display of the log events
   function Get_Level (Self : in Appender) return Level_Type;

   --  Set the log level.
   procedure Set_Level (Self       : in out Appender;
                        Name       : in String;
                        Properties : in Util.Properties.Manager;
                        Level      : in Level_Type);

   --  Set the log layout format.
   procedure Set_Layout (Self       : in out Appender;
                         Name       : in String;
                         Properties : in Util.Properties.Manager;
                         Layout     : in Layout_Type);

   --  Format the event into a string
   function Format (Self  : in Appender;
                    Event : in Log_Event) return String;

   --  Append a log event to the appender.  Depending on the log level
   --  defined on the appender, the event can be taken into account or
   --  ignored.
   procedure Append (Self  : in out Appender;
                     Event : in Log_Event) is abstract;

   --  Flush the log events.
   procedure Flush (Self   : in out Appender) is abstract;

   --  ------------------------------
   --  File appender
   --  ------------------------------
   --  Write log events to a file
   type File_Appender is new Appender with private;
   type File_Appender_Access is access all File_Appender'Class;

   overriding
   procedure Append (Self  : in out File_Appender;
                     Event : in Log_Event);

   --  Set the file where the appender will write the logs.
   --  When <tt>Append</tt> is true, the log message are appended to the existing file.
   --  When set to false, the file is cleared before writing new messages.
   procedure Set_File (Self   : in out File_Appender;
                       Path   : in String;
                       Append : in Boolean := True);

   --  Flush the log events.
   overriding
   procedure Flush (Self   : in out File_Appender);

   --  Flush and close the file.
   overriding
   procedure Finalize (Self : in out File_Appender);

   --  Create a file appender and configure it according to the properties
   function Create_File_Appender (Name       : in String;
                                  Properties : in Util.Properties.Manager;
                                  Default    : in Level_Type)
     return Appender_Access;

   --  ------------------------------
   --  Console appender
   --  ------------------------------
   --  Write log events to the console
   type Console_Appender is new Appender with private;
   type Console_Appender_Access is access all Console_Appender'Class;

   overriding
   procedure Append (Self  : in out Console_Appender;
                     Event : in Log_Event);

   --  Flush the log events.
   overriding
   procedure Flush (Self   : in out Console_Appender);

   --  Create a console appender and configure it according to the properties
   function Create_Console_Appender (Name       : in String;
                                     Properties : in Util.Properties.Manager;
                                     Default    : in Level_Type)
                                     return Appender_Access;

   --  ------------------------------
   --  List appender
   --  ------------------------------
   --  Write log events to a list of appenders
   type List_Appender is new Appender with private;
   type List_Appender_Access is access all List_Appender'Class;

   --  Max number of appenders that can be added to the list.
   --  In most cases, 2 or 3 appenders will be used.
   MAX_APPENDERS : constant Natural := 10;

   overriding
   procedure Append (Self  : in out List_Appender;
                     Event : in Log_Event);

   --  Flush the log events.
   overriding
   procedure Flush (Self   : in out List_Appender);

   --  Add the appender to the list.
   procedure Add_Appender (Self   : in out List_Appender;
                           Object : in Appender_Access);

   --  Create a list appender and configure it according to the properties
   function Create_List_Appender return List_Appender_Access;

private

   type Appender is abstract new Ada.Finalization.Limited_Controlled with record
      Level    : Level_Type := INFO_LEVEL;
      Layout   : Layout_Type := FULL;
   end record;

   type File_Appender is new Appender with record
      Output          : Ada.Text_IO.File_Type;
      Immediate_Flush : Boolean := False;
   end record;

   type Appender_Array_Access is array (1 .. MAX_APPENDERS) of Appender_Access;

   type List_Appender is new Appender with record
      Appenders : Appender_Array_Access;
      Count     : Natural := 0;
   end record;

   type Console_Appender is new Appender with null record;

end Util.Log.Appenders;

Fix header style

Fix header style