-----------------------------------------------------------------------
--  atlas-microblog-beans -- Beans for module microblog
--  Copyright (C) 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 ADO.Sessions;
with ADO.Queries;

with ASF.Events.Faces.Actions;
package body Atlas.Microblog.Beans is

   --  ------------------------------
   --  Example of action method.
   --  ------------------------------
   procedure Post (Bean    : in out Microblog_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Create (Bean.Post);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("post-response");
   end Post;

   package Action_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Microblog_Bean,
                                                      Method => Post,
                                                      Name   => "post");

   Microblog_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Action_Binding.Proxy'Access, null);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Microblog_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Post.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return From.Post.Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Microblog_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "message" then
         From.Post.Set_Message (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Microblog_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Microblog_Bean_Binding'Access;
   end Get_Method_Bindings;

   --  ------------------------------
   --  Create the Microblog_Bean bean instance.
   --  ------------------------------
   function Create_Microblog_Bean (Module : in Atlas.Microblog.Modules.Microblog_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Microblog_Bean_Access := new Microblog_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Microblog_Bean;

   --  ------------------------------
   --  Create the a bean to display the list of microblog posts.
   --  ------------------------------
   function Create_List_Bean (Module : in Atlas.Microblog.Modules.Microblog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access is
      use Models;

      Result  : constant List_Info_List_Bean_Access := new List_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (Atlas.Microblog.Models.Query_List);
      Atlas.Microblog.Models.List (Result.all, Session, Query);
      return Result.all'Access;
   end Create_List_Bean;

end Atlas.Microblog.Beans;

-----------------------------------------------------------------------
--  atlas-microblog-beans -- Beans for module microblog
--  Copyright (C) 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 ADO.Sessions;
with ADO.Queries;

with ASF.Events.Faces.Actions;
with AWA.Events.Action_Method;
package body Atlas.Microblog.Beans is

   --  ------------------------------
   --  Example of action method.
   --  ------------------------------
   procedure Post (Bean    : in out Microblog_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Create (Bean.Post);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("post-response");
   end Post;

   --  ------------------------------
   --  Post a message when some event is received.
   --  ------------------------------
   procedure Post (Bean    : in out Microblog_Bean;
                   Event   : in AWA.Events.Module_Event'Class) is
   begin
      Bean.Module.Create (Bean.Post);
   end Post;

   package Action_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Microblog_Bean,
                                                      Method => Post,
                                                      Name   => "post");

   package Event_Action_Binding is
     new AWA.Events.Action_Method.Bind (Bean   => Microblog_Bean,
                                        Method => Post,
                                        Name   => "post_event");

   Microblog_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Action_Binding.Proxy'Access, Event_Action_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Microblog_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Post.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return From.Post.Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Microblog_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "message" then
         From.Post.Set_Message (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Microblog_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Microblog_Bean_Binding'Access;
   end Get_Method_Bindings;

   --  ------------------------------
   --  Create the Microblog_Bean bean instance.
   --  ------------------------------
   function Create_Microblog_Bean (Module : in Atlas.Microblog.Modules.Microblog_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Microblog_Bean_Access := new Microblog_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Microblog_Bean;

   --  ------------------------------
   --  Create the a bean to display the list of microblog posts.
   --  ------------------------------
   function Create_List_Bean (Module : in Atlas.Microblog.Modules.Microblog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access is
      use Models;

      Result  : constant List_Info_List_Bean_Access := new List_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (Atlas.Microblog.Models.Query_List);
      Atlas.Microblog.Models.List (Result.all, Session, Query);
      return Result.all'Access;
   end Create_List_Bean;

end Atlas.Microblog.Beans;

Implement the Post procedure with an event parameter and register the operation as event bean operation


-----------------------------------------------------------------------
--  gen-commands-generate -- Generate command for dynamo
--  Copyright (C) 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 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.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);

      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.
   --  ------------------------------
   procedure Help (Cmd       : in 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 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 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 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;

Update to use the new command implementation


pragma License (Modified_GPL);
------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: Modified GNU GPLv3 or any later as published by Free Software   --
--  Foundation (GMGPL, see COPYING file).                                   --
--                                                                          --
--                    Copyright © 2014 darkestkhan                          --
------------------------------------------------------------------------------
--  This Program is Free Software: You can redistribute it and/or modify    --
--  it under the terms of The GNU General Public License as published by    --
--    the Free Software Foundation: either version 3 of the license, or     --
--                 (at your option) any later version.                      --
--                                                                          --
--      This Program is distributed in the hope that it will be useful,     --
--      but WITHOUT ANY WARRANTY; without even the implied warranty of      --
--      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the        --
--              GNU General Public License for more details.                --
--                                                                          --
--    You should have received a copy of the GNU General Public License     --
--   along with this program.  If not, see <http://www.gnu.org/licenses/>.  --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
------------------------------------------------------------------------------
with System;

with Oto.Binary;
use Oto;
package Oto.ALC is

  ---------------------------------------------------------------------------

                              ---------------
                              -- T Y P E S --
                              ---------------

  ---------------------------------------------------------------------------
  -- Due to the fact that only pointers to device and context are passed
  -- we ar going to use System.Address for them.
  subtype Context is System.Address;
  subtype Device  is System.Address;

  subtype Bool    is Binary.Byte;
  subtype Char    is Binary.S_Byte;
  subtype Double  is Long_Float;
  subtype Enum    is Binary.S_Word;
  subtype Int     is Integer;
  subtype Pointer is System.Address;
  subtype Short   is Binary.S_Short;
  subtype SizeI   is Integer;
  subtype UByte   is Binary.Byte;
  subtype UInt    is Binary.Word;
  subtype UShort  is Binary.Short;

  ---------------------------------------------------------------------------

                          -----------------------
                          -- C O N S T A N T S --
                          -----------------------

  ---------------------------------------------------------------------------
  -- Bool constants.
  ALC_FALSE                                : constant Bool := 0;
  ALC_TRUE                                 : constant Bool := 1;

  -- Followed by <Int> Hz
  ALC_FREQUENCY                            : constant Enum := 16#1007#;

  -- Followed by <Int> Hz
  ALC_REFRESH                              : constant Enum := 16#1008#;

  -- Followed by AL_TRUE, AL_FALSE
  ALC_SYNC                                 : constant Enum := 16#1009#;

  -- Followed by <Int> Num of requested Mono (3D) Sources
  ALC_MONO_SOURCES                         : constant Enum := 16#1010#;

  -- Followed by <Int> Num of requested Stereo Sources
  ALC_STEREO_SOURCES                       : constant Enum := 16#1011#;

  -- Errors
  -- No error
  ALC_NO_ERROR                             : constant Enum := 0;

  -- No device
  ALC_INVALID_DEVICE                       : constant Enum := 16#A001#;

  -- Invalid context ID
  ALC_INVALID_CONTEXT                      : constant Enum := 16#A002#;

  -- Bad enum
  ALC_INVALID_ENUM                         : constant Enum := 16#A003#;

  -- Bad value
  ALC_INVALID_VALUE                        : constant Enum := 16#A004#;

  -- Out of memory.
  ALC_OUT_OF_MEMORY                        : constant Enum := 16#A005#;

  -- The Specifier string for default device
  ALC_DEFAULT_DEVICE_SPECIFIER             : constant Enum := 16#1004#;
  ALC_DEVICE_SPECIFIER                     : constant Enum := 16#1005#;
  ALC_EXTENSIONS                           : constant Enum := 16#1006#;

  ALC_MAJOR_VERSION                        : constant Enum := 16#1000#;
  ALC_MINOR_VERSION                        : constant Enum := 16#1001#;

  ALC_ATTRIBUTES_SIZE                      : constant Enum := 16#1002#;
  ALC_ALL_ATTRIBUTES                       : constant Enum := 16#1003#;

  -- Capture extension
  ALC_EXT_CAPTURE                          : constant Enum := 1;
  ALC_CAPTURE_DEVICE_SPECIFIER             : constant Enum := 16#310#;
  ALC_CAPTURE_DEFAULT_DEVICE_SPECIFIER     : constant Enum := 16#311#;
  ALC_CAPTURE_SAMPLES                      : constant Enum := 16#312#;

  -- ALC_ENUMERATE_ALL_EXT enums
  ALC_ENUMERATE_ALL_EXT                    : constant Enum := 1;
  ALC_DEFAULT_ALL_DEVICES_SPECIFIER        : constant Enum := 16#1012#;
  ALC_ALL_DEVICES_SPECIFIER                : constant Enum := 16#1013#;

  ---------------------------------------------------------------------------

                    ---------------------------
                    -- S U B P R O G R A M S --
                    ---------------------------

  ---------------------------------------------------------------------------
  -- Context Management
  function Create_Context
    ( ADevice: in Device;
      Attr_List: in Pointer
    ) return Context;
  Pragma Import (StdCall, Create_Context, "alcCreateContext");
--ALC_API ALCcontext *    ALC_APIENTRY alcCreateContext( ALCdevice *device, const ALCint* attrlist );

  function Make_Context_Current (AContext: in Context) return Bool;
  Pragma Import (StdCall, Make_Context_Current, "alcMakeContextCurrent");
--ALC_API ALCboolean      ALC_APIENTRY alcMakeContextCurrent( ALCcontext *context );

  procedure Process_Context (AContext: in Context);
  Pragma Import (StdCall, Process_Context, "alcProcessContext");
--ALC_API void            ALC_APIENTRY alcProcessContext( ALCcontext *context );

  procedure Suspend_Context (AContext: in Context);
  Pragma Import (StdCall, Suspend_Context, "alcSuspendContext");
--ALC_API void            ALC_APIENTRY alcSuspendContext( ALCcontext *context );

  procedure Destroy_Context (AContext: in Context);
  Pragma Import (StdCall, Destroy_Context, "alcDestroyContext");
--ALC_API void            ALC_APIENTRY alcDestroyContext( ALCcontext *context );

  function Get_Current_Context return Context;
  Pragma Import (StdCall, Get_Current_Context, "alcGetCurrentContext");
--ALC_API ALCcontext *    ALC_APIENTRY alcGetCurrentContext( void );

  function Get_Contexts_Device (AContext: in Context) return Device;
  Pragma Import (StdCall, Get_Contexts_Device, "alcGetContextsDevice");
--ALC_API ALCdevice*      ALC_APIENTRY alcGetContextsDevice( ALCcontext *context );

  -- Device Management
  function Open_Device (Device_Name: in String) return Device;
  Pragma Inline (Open_Device);

  function Close_Device (ADevice: in Device) return Bool;
  Pragma Import (StdCall, Close_Device, "alcCloseDevice");

  -- Error support.
  -- Obtain the most recent Context error
  function Get_Error (ADevice: in Device) return Enum;
  Pragma Import (StdCall, Get_Error, "alcGetError");

  -- Extension support.
  -- Query for the presence of an extension, and obtain any appropriate
  -- function pointers and enum values.
  function Is_Extension_Present
    ( ADevice: in Device;
      Ext_Name: in String
    ) return Bool;
  Pragma Inline (Is_Extension_Present);

  function Get_Proc_Address
    ( ADevice: in Device;
      Func_Name: in String
    ) return Pointer;
  Pragma Inline (Get_Proc_Address);

  function Get_Enum_Value
    ( ADevice: in Device;
      Enum_Name: in String
    ) return Enum;
  Pragma Inline (Get_Enum_Value);

  -- Query functions
  function Get_String (ADevice: in Device; Param: in Enum) return String;
  Pragma Inline (Get_String);

  procedure Get_Integer
    ( ADevice: in Device;
      Param: in Enum;
      Size: in SizeI;
      Data: in Pointer
    );
  Pragma Import (StdCall, Get_Integer, "alcGetIntegerv");

  -- Capture functions
  function Capture_Open_Device
    ( Device_Name: in String;
      Frequency: in UInt;
      Format: in Enum;
      Buffer_Size: in SizeI
    ) return Device;
  Pragma Inline (Capture_Open_Device);

  function Capture_Close_Device (ADevice: in Device) return Bool;
  Pragma Import (StdCall, Capture_Close_Device, "alcCaptureCloseDevice");

  procedure Capture_Start (ADevice: in Device);
  Pragma Import (StdCall, Capture_Start, "alcCaptureStart");

  procedure Capture_Stop (ADevice: in Device);
  Pragma Import (StdCall, Capture_Stop, "alcCaptureStop");

  procedure Capture_Samples
    ( ADevice: in Device;
      Buffer: in Pointer;
      Samples: in SizeI
    );
  Pragma Import (StdCall, Capture_Samples, "alcCaptureSamples");

  ---------------------------------------------------------------------------

end Oto.ALC;

pragma License (Modified_GPL);
------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: Modified GNU GPLv3 or any later as published by Free Software   --
--  Foundation (GMGPL, see COPYING file).                                   --
--                                                                          --
--                    Copyright © 2014 darkestkhan                          --
------------------------------------------------------------------------------
--  This Program is Free Software: You can redistribute it and/or modify    --
--  it under the terms of The GNU General Public License as published by    --
--    the Free Software Foundation: either version 3 of the license, or     --
--                 (at your option) any later version.                      --
--                                                                          --
--      This Program is distributed in the hope that it will be useful,     --
--      but WITHOUT ANY WARRANTY; without even the implied warranty of      --
--      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the        --
--              GNU General Public License for more details.                --
--                                                                          --
--    You should have received a copy of the GNU General Public License     --
--   along with this program.  If not, see <http://www.gnu.org/licenses/>.  --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
------------------------------------------------------------------------------
with System;

with Oto.Binary;
use Oto;
package Oto.ALC is

  ---------------------------------------------------------------------------

                              ---------------
                              -- T Y P E S --
                              ---------------

  ---------------------------------------------------------------------------
  -- Due to the fact that only pointers to device and context are passed
  -- we ar going to use System.Address for them.
  subtype Context is System.Address;
  subtype Device  is System.Address;

  subtype Bool    is Binary.Byte;
  subtype Char    is Binary.S_Byte;
  subtype Double  is Long_Float;
  subtype Enum    is Binary.S_Word;
  subtype Int     is Integer;
  subtype Pointer is System.Address;
  subtype Short   is Binary.S_Short;
  subtype SizeI   is Integer;
  subtype UByte   is Binary.Byte;
  subtype UInt    is Binary.Word;
  subtype UShort  is Binary.Short;

  ---------------------------------------------------------------------------

                          -----------------------
                          -- C O N S T A N T S --
                          -----------------------

  ---------------------------------------------------------------------------
  -- Bool constants.
  ALC_FALSE                                : constant Bool := 0;
  ALC_TRUE                                 : constant Bool := 1;

  -- Followed by <Int> Hz
  ALC_FREQUENCY                            : constant Enum := 16#1007#;

  -- Followed by <Int> Hz
  ALC_REFRESH                              : constant Enum := 16#1008#;

  -- Followed by AL_TRUE, AL_FALSE
  ALC_SYNC                                 : constant Enum := 16#1009#;

  -- Followed by <Int> Num of requested Mono (3D) Sources
  ALC_MONO_SOURCES                         : constant Enum := 16#1010#;

  -- Followed by <Int> Num of requested Stereo Sources
  ALC_STEREO_SOURCES                       : constant Enum := 16#1011#;

  -- Errors
  -- No error
  ALC_NO_ERROR                             : constant Enum := 0;

  -- No device
  ALC_INVALID_DEVICE                       : constant Enum := 16#A001#;

  -- Invalid context ID
  ALC_INVALID_CONTEXT                      : constant Enum := 16#A002#;

  -- Bad enum
  ALC_INVALID_ENUM                         : constant Enum := 16#A003#;

  -- Bad value
  ALC_INVALID_VALUE                        : constant Enum := 16#A004#;

  -- Out of memory.
  ALC_OUT_OF_MEMORY                        : constant Enum := 16#A005#;

  -- The Specifier string for default device
  ALC_DEFAULT_DEVICE_SPECIFIER             : constant Enum := 16#1004#;
  ALC_DEVICE_SPECIFIER                     : constant Enum := 16#1005#;
  ALC_EXTENSIONS                           : constant Enum := 16#1006#;

  ALC_MAJOR_VERSION                        : constant Enum := 16#1000#;
  ALC_MINOR_VERSION                        : constant Enum := 16#1001#;

  ALC_ATTRIBUTES_SIZE                      : constant Enum := 16#1002#;
  ALC_ALL_ATTRIBUTES                       : constant Enum := 16#1003#;

  -- Capture extension
  ALC_EXT_CAPTURE                          : constant Enum := 1;
  ALC_CAPTURE_DEVICE_SPECIFIER             : constant Enum := 16#310#;
  ALC_CAPTURE_DEFAULT_DEVICE_SPECIFIER     : constant Enum := 16#311#;
  ALC_CAPTURE_SAMPLES                      : constant Enum := 16#312#;

  -- ALC_ENUMERATE_ALL_EXT enums
  ALC_ENUMERATE_ALL_EXT                    : constant Enum := 1;
  ALC_DEFAULT_ALL_DEVICES_SPECIFIER        : constant Enum := 16#1012#;
  ALC_ALL_DEVICES_SPECIFIER                : constant Enum := 16#1013#;

  ---------------------------------------------------------------------------

                    ---------------------------
                    -- S U B P R O G R A M S --
                    ---------------------------

  ---------------------------------------------------------------------------
  -- Context Management
  function Create_Context
    ( ADevice: in Device;
      Attr_List: in Pointer
    ) return Context;
--ALC_API ALCcontext *    ALC_APIENTRY alcCreateContext( ALCdevice *device, const ALCint* attrlist );

  function Make_Context_Current (AContext: in Context) return Bool;
--ALC_API ALCboolean      ALC_APIENTRY alcMakeContextCurrent( ALCcontext *context );

  procedure Process_Context (AContext: in Context);
--ALC_API void            ALC_APIENTRY alcProcessContext( ALCcontext *context );

  procedure Suspend_Context (AContext: in Context);
--ALC_API void            ALC_APIENTRY alcSuspendContext( ALCcontext *context );

  procedure Destroy_Context (AContext: in Context);
--ALC_API void            ALC_APIENTRY alcDestroyContext( ALCcontext *context );

  function Get_Current_Context return Context;
--ALC_API ALCcontext *    ALC_APIENTRY alcGetCurrentContext( void );

  function Get_Contexts_Device (AContext: in Context) return Device;
--ALC_API ALCdevice*      ALC_APIENTRY alcGetContextsDevice( ALCcontext *context );

  -- Device Management
  function Open_Device (Device_Name: in String) return Device;
  Pragma Inline (Open_Device);

  function Close_Device (ADevice: in Device) return Bool;

  -- Error support.
  -- Obtain the most recent Context error
  function Get_Error (ADevice: in Device) return Enum;

  -- Extension support.
  -- Query for the presence of an extension, and obtain any appropriate
  -- function pointers and enum values.
  function Is_Extension_Present
    ( ADevice: in Device;
      Ext_Name: in String
    ) return Bool;
  Pragma Inline (Is_Extension_Present);

  function Get_Proc_Address
    ( ADevice: in Device;
      Func_Name: in String
    ) return Pointer;
  Pragma Inline (Get_Proc_Address);

  function Get_Enum_Value
    ( ADevice: in Device;
      Enum_Name: in String
    ) return Enum;
  Pragma Inline (Get_Enum_Value);

  -- Query functions
  function Get_String (ADevice: in Device; Param: in Enum) return String;
  Pragma Inline (Get_String);

  procedure Get_Integer
    ( ADevice: in Device;
      Param: in Enum;
      Size: in SizeI;
      Data: in Pointer
    );

  -- Capture functions
  function Capture_Open_Device
    ( Device_Name: in String;
      Frequency: in UInt;
      Format: in Enum;
      Buffer_Size: in SizeI
    ) return Device;
  Pragma Inline (Capture_Open_Device);

  function Capture_Close_Device (ADevice: in Device) return Bool;

  procedure Capture_Start (ADevice: in Device);

  procedure Capture_Stop (ADevice: in Device);

  procedure Capture_Samples
    ( ADevice: in Device;
      Buffer: in Pointer;
      Samples: in SizeI
    );

  ---------------------------------------------------------------------------

private

  ---------------------------------------------------------------------------

                            -------------------
                            -- I M P O R T S --
                            -------------------

  ---------------------------------------------------------------------------

  Pragma Import (StdCall, Create_Context, "alcCreateContext");
  Pragma Import (StdCall, Make_Context_Current, "alcMakeContextCurrent");
  Pragma Import (StdCall, Process_Context, "alcProcessContext");
  Pragma Import (StdCall, Suspend_Context, "alcSuspendContext");
  Pragma Import (StdCall, Destroy_Context, "alcDestroyContext");
  Pragma Import (StdCall, Get_Current_Context, "alcGetCurrentContext");
  Pragma Import (StdCall, Get_Contexts_Device, "alcGetContextsDevice");
  Pragma Import (StdCall, Close_Device, "alcCloseDevice");
  Pragma Import (StdCall, Get_Error, "alcGetError");
  Pragma Import (StdCall, Get_Integer, "alcGetIntegerv");
  Pragma Import (StdCall, Capture_Close_Device, "alcCaptureCloseDevice");
  Pragma Import (StdCall, Capture_Start, "alcCaptureStart");
  Pragma Import (StdCall, Capture_Stop, "alcCaptureStop");
  Pragma Import (StdCall, Capture_Samples, "alcCaptureSamples");

  ---------------------------------------------------------------------------

end Oto.ALC;

Move Imports to private part.

ALC: Move Imports to private part.

Signed-off-by: darkestkhan <e9a7a7cf2a6af79e93742343a7a5cac5d90f9bd2@gmail.com>


-----------------------------------------------------------------------
--  awa-wikis-previews -- Wiki preview management
--  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 Util.Log.Loggers;

package body AWA.Wikis.Previews is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Wikis.Preview");

   --  The worker procedure that performs the preview job.
   procedure Preview_Worker (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
   begin
      null;
   end Preview_Worker;

   --  Initialize the wikis module.
   overriding
   procedure Initialize (Plugin : in out Preview_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the wiki preview module");

      AWA.Modules.Module (Plugin).Initialize (App, Props);
      Plugin.Add_Listener (AWA.Wikis.Modules.NAME, Plugin'Unchecked_Access);
   end Initialize;

   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the page.
   overriding
   procedure On_Create (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      null;
   end On_Create;

   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the page.
   overriding
   procedure On_Update (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      null;
   end On_Update;

   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the page.
   overriding
   procedure On_Delete (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      null;
   end On_Delete;

end AWA.Wikis.Previews;

-----------------------------------------------------------------------
--  awa-wikis-previews -- Wiki preview management
--  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 Util.Log.Loggers;

with AWA.Jobs.Services;
with AWA.Jobs.Modules;
package body AWA.Wikis.Previews is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Wikis.Preview");

   --  ------------------------------
   --  The worker procedure that performs the preview job.
   --  ------------------------------
   procedure Preview_Worker (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
   begin
      null;
   end Preview_Worker;

   --  ------------------------------
   --  Initialize the wikis module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Preview_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the wiki preview module");

      AWA.Modules.Module (Plugin).Initialize (App, Props);
      Plugin.Add_Listener (AWA.Wikis.Modules.NAME, Plugin'Unchecked_Access);
      Plugin.Job_Module := AWA.Jobs.Modules.Get_Job_Module;
      Plugin.Job_Module.Register (Definition => Preview_Job_Definition.Factory);
   end Initialize;

   --  ------------------------------
   --  Create a preview job and schedule the job to generate a new thumbnail preview for the page.
   --  ------------------------------
   procedure Make_Preview_Job (Plugin : in Preview_Module;
                               Page   : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
      J : AWA.Jobs.Services.Job_Type;
   begin
      J.Set_Parameter ("wiki_space_id", Page.Get_Wiki);
      J.Set_Parameter ("wiki_page_id", Page);
      J.Schedule (Preview_Job_Definition.Factory.all);
   end Make_Preview_Job;

   --  ------------------------------
   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the page.
   --  ------------------------------
   overriding
   procedure On_Create (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      null;
   end On_Create;

   --  ------------------------------
   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the page.
   --  ------------------------------
   overriding
   procedure On_Update (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      null;
   end On_Update;

   --  ------------------------------
   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the page.
   --  ------------------------------
   overriding
   procedure On_Delete (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class) is
   begin
      null;
   end On_Delete;

end AWA.Wikis.Previews;

Implement the Make_Preview_Job operation: schedule the preview job for the wiki page


with Ada.Wide_Characters.Unicode; -- GNAT Specific.

package body Symbex.Lex is
  package Unicode renames Ada.Wide_Characters.Unicode;

  --
  -- Private subprograms.
  --

  procedure Set_State
    (Lexer : in out Lexer_t;
     State : in     State_Stage_t) is
  begin
    Lexer.State (State) := True;
  end Set_State;

  procedure Unset_State
    (Lexer : in out Lexer_t;
     State : in     State_Stage_t) is
  begin
    Lexer.State (State) := False;
  end Unset_State;

  function State_Is_Set
    (Lexer : in Lexer_t;
     State : in State_Stage_t) return Boolean is
  begin
    return Lexer.State (State);
  end State_Is_Set;

  --
  -- Return true if internal token buffer contains data.
  --

  function Token_Is_Nonzero_Length
    (Lexer : in Lexer_t) return Boolean is
  begin
    return UBW_Strings.Length (Lexer.Token_Buffer) /= 0;
  end Token_Is_Nonzero_Length;

  --
  -- Append item to internal token buffer.
  --

  procedure Append_To_Token
    (Lexer : in out Lexer_t;
     Item  : in     Wide_Character) is
  begin
    UBW_Strings.Append (Lexer.Token_Buffer, Item);
  end Append_To_Token;

  --
  -- Finish token in buffer and assign kind Kind.
  --

  procedure Complete_Token
    (Lexer : in out Lexer_t;
     Kind  : in     Token_Kind_t;
     Token :    out Token_t) is
  begin
    Token := Token_t'
      (Is_Valid    => True,
       Line_Number => Lexer.Current_Line,
       Text        => Lexer.Token_Buffer,
       Kind        => Kind);
    Lexer.Token_Buffer := UBW_Strings.Null_Unbounded_Wide_String;
  end Complete_Token;

  --
  -- Categorize Item into character class.
  --

  function Categorize_Character
    (Item : in Wide_Character) return Character_Class_t
  is
    Class : Character_Class_t := Ordinary_Text;
  begin
    case Item is
      when '('    => Class := List_Open_Delimiter;
      when ')'    => Class := List_Close_Delimiter;
      when '"'    => Class := String_Delimiter;
      when ';'    => Class := Comment_Delimiter;
      when '\'    => Class := Escape_Character;
      when others =>
        if Unicode.Is_Line_Terminator (Item) then
          Class := Line_Break;
        else
          if Unicode.Is_Space (Item) then
            Class := Whitespace;
          end if;
        end if;
    end case;
    return Class;
  end Categorize_Character;

  --
  -- Public API.
  --

  function Initialized (Lexer : in Lexer_t) return Boolean is
  begin
    return Lexer.Inited;
  end Initialized;

  --
  -- Initialize the lexer.
  --

  procedure Initialize_Lexer
    (Lexer  :    out Lexer_t;
     Status :    out Lexer_Status_t) is
  begin
    Lexer := Lexer_t'
      (Inited       => True,
       Current_Line => Line_Number_t'First,
       Token_Buffer => UBW_Strings.Null_Unbounded_Wide_String,
       Input_Buffer => Input_Buffer_t'(others => Wide_Character'Val (0)),
       State        => State_t'(others => False));
    Status       := Lexer_OK;
  end Initialize_Lexer;

  --
  -- Retrieve token from input stream.
  --

  procedure Get_Token
    (Lexer     : in out Lexer_t;
     Token     :    out Token_t;
     Status    :    out Lexer_Status_t)
  is
    --
    -- Stream characters via Read_Item.
    --
    procedure Fetch_Characters
      (Lexer     : in out Lexer_t;
       Item      :    out Wide_Character;
       Item_Next :    out Wide_Character;
       Status    :    out Stream_Status_t)
    is
      Null_Item : constant Wide_Character := Wide_Character'Val (0);
    begin
      if Lexer.Input_Buffer (Next) /= Null_Item then
        Lexer.Input_Buffer (Current) := Lexer.Input_Buffer (Next);
        Read_Item
          (Item   => Lexer.Input_Buffer (Next),
           Status => Status);
        case Status is
          when Stream_EOF   =>
            Lexer.Input_Buffer (Next) := Null_Item;
            Status                    := Stream_OK;
          when Stream_Error => null;
          when Stream_OK    => null;
        end case;
      else
        Read_Item
          (Item   => Lexer.Input_Buffer (Current),
           Status => Status);
        Read_Item
          (Item   => Lexer.Input_Buffer (Next),
           Status => Status);
        case Status is
          when Stream_EOF   => Lexer.Input_Buffer (Next) := Null_Item;
          when Stream_Error => null;
          when Stream_OK    => null;
        end case;
      end if;

      Item      := Lexer.Input_Buffer (Current);
      Item_Next := Lexer.Input_Buffer (Next);
    end Fetch_Characters;

    Item          : Wide_Character;
    Item_Next     : Wide_Character;
    Stream_Status : Stream_Status_t;
  begin
    -- Default status.
    Status := Lexer_Needs_More_Data;
    Token  := Invalid_Token;

    -- Fetch characters from input stream.
    Fetch_Characters
      (Lexer     => Lexer,
       Item      => Item,
       Item_Next => Item_Next,
       Status    => Stream_Status);
    case Stream_Status is
      when Stream_OK    => null;
      when Stream_Error =>
        Status := Lexer_Error_Stream_Error;
        return;
      when Stream_EOF   =>
        if State_Is_Set (Lexer, Inside_String) or
           State_Is_Set (Lexer, Inside_Escape) or
           State_Is_Set (Lexer, Inside_Comment) then
          Status := Lexer_Error_Early_EOF;
        else
          -- Reached upon EOF with no preceding newline/whitespace.
          Status := Lexer_OK;

          -- Have unfinished token?
          if Token_Is_Nonzero_Length (Lexer) then
            Complete_Token
              (Lexer => Lexer,
               Token => Token,
               Kind  => Token_Symbol);
          else
            Append_To_Token (Lexer, 'E');
            Complete_Token
              (Lexer => Lexer,
               Token => Token,
               Kind  => Token_EOF);
          end if;
        end if;
        return;
    end case;

    pragma Assert (Stream_Status = Stream_OK);

    -- Process character.
    case Categorize_Character (Item) is
      when Comment_Delimiter =>
        if State_Is_Set (Lexer, Inside_String) or
           State_Is_Set (Lexer, Inside_Escape) then
          Append_To_Token (Lexer, Item);
        else
          if not State_Is_Set (Lexer, Inside_Comment) then
            Set_State (Lexer, Inside_Comment);
          end if;
        end if;
      when Escape_Character =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          if State_Is_Set (Lexer, Inside_String) then
            if State_Is_Set (Lexer, Inside_Escape) then
              Append_To_Token (Lexer, Item);
              Unset_State (Lexer, Inside_Escape);
            else
              Set_State (Lexer, Inside_Escape);
            end if;
          end if;
        end if;
      when Line_Break =>
        if State_Is_Set (Lexer, Inside_Comment) then
          Unset_State (Lexer, Inside_Comment);
        else
          begin
            -- Potential overflow.
            Lexer.Current_Line := Lexer.Current_Line + 1;

            if State_Is_Set (Lexer, Inside_Escape) then
              Unset_State (Lexer, Inside_Escape);
            end if;
            if State_Is_Set (Lexer, Inside_String) then
              Append_To_Token (Lexer, Item);
            else
              if Token_Is_Nonzero_Length (Lexer) then
                Status := Lexer_OK;
                Complete_Token
                  (Lexer => Lexer,
                   Token => Token,
                   Kind  => Token_Symbol);
              end if;
            end if;
          exception
            when Constraint_Error =>
              Status := Lexer_Error_Line_Overflow;
              Token  := Invalid_Token;
          end;
        end if;
      when List_Open_Delimiter =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          Append_To_Token (Lexer, Item);
          if not State_Is_Set (Lexer, Inside_String) then
            Status := Lexer_OK;
            Complete_Token
              (Lexer => Lexer,
               Token => Token,
                Kind => Token_List_Open);
          end if;
        end if;
      when List_Close_Delimiter =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          Append_To_Token (Lexer, Item);
          if not State_Is_Set (Lexer, Inside_String) then
            Status := Lexer_OK;
            Complete_Token
              (Lexer => Lexer,
               Token => Token,
               Kind  => Token_List_Close);
          end if;
        end if;
      when String_Delimiter =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          if State_Is_Set (Lexer, Inside_String) then
            if State_Is_Set (Lexer, Inside_Escape) then
              Append_To_Token (Lexer, Item);
              Unset_State (Lexer, Inside_Escape);
            else
              Status := Lexer_OK;
              Complete_Token
                (Lexer => Lexer,
                 Token => Token,
                 Kind  => Token_Quoted_String);
              Unset_State (Lexer, Inside_String);
            end if;
          else
            Set_State (Lexer, Inside_String);
          end if;
        end if;
      when Whitespace =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          if State_Is_Set (Lexer, Inside_Escape) then
            Unset_State (Lexer, Inside_Escape);
          end if;
          if State_Is_Set (Lexer, Inside_String) then
            Append_To_Token (Lexer, Item);
          else
            if Token_Is_Nonzero_Length (Lexer) then
              Status := Lexer_OK;
              Complete_Token
                (Lexer => Lexer,
                 Token => Token,
                 Kind  => Token_Symbol);
            end if;
          end if;
        end if;
      when Ordinary_Text =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          if State_Is_Set (Lexer, Inside_Escape) then
            Unset_State (Lexer, Inside_Escape);
          end if;
          Append_To_Token (Lexer, Item);

          -- End of token if not inside a string.
          case Categorize_Character (Item_Next) is
            when List_Open_Delimiter | List_Close_Delimiter | String_Delimiter =>
              if not State_Is_Set (Lexer, Inside_String) then
                Status := Lexer_OK;
                Complete_Token
                  (Lexer => Lexer,
                   Token => Token,
                   Kind  => Token_Symbol);
              end if;
            when others => null;
          end case;
        end if;
    end case;
  exception
    when Storage_Error =>
      Status := Lexer_Error_Out_Of_Memory;
      Token  := Invalid_Token;
  end Get_Token;

end Symbex.Lex;

with Ada.Wide_Characters.Unicode; -- GNAT Specific.

-- with Ada.Text_IO;

package body Symbex.Lex is
  package Unicode renames Ada.Wide_Characters.Unicode;

  --
  -- Private subprograms.
  --

  procedure Set_State
    (Lexer : in out Lexer_t;
     State : in     State_Stage_t) is
  begin
    Lexer.State (State) := True;
  end Set_State;

  procedure Unset_State
    (Lexer : in out Lexer_t;
     State : in     State_Stage_t) is
  begin
    Lexer.State (State) := False;
  end Unset_State;

  function State_Is_Set
    (Lexer : in Lexer_t;
     State : in State_Stage_t) return Boolean is
  begin
    return Lexer.State (State);
  end State_Is_Set;

  --
  -- Return true if internal token buffer contains data.
  --

  function Token_Is_Nonzero_Length
    (Lexer : in Lexer_t) return Boolean is
  begin
--    Ada.Text_IO.Put_Line ("length: " & Natural'Image (UBW_Strings.Length (Lexer.Token_Buffer)));
    return UBW_Strings.Length (Lexer.Token_Buffer) /= 0;
  end Token_Is_Nonzero_Length;

  --
  -- Append item to internal token buffer.
  --

  procedure Append_To_Token
    (Lexer : in out Lexer_t;
     Item  : in     Wide_Character) is
  begin
    UBW_Strings.Append (Lexer.Token_Buffer, Item);
  end Append_To_Token;

  --
  -- Finish token in buffer and assign kind Kind.
  --

  procedure Complete_Token
    (Lexer : in out Lexer_t;
     Kind  : in     Token_Kind_t;
     Token :    out Token_t) is
  begin
    Token := Token_t'
      (Is_Valid    => True,
       Line_Number => Lexer.Current_Line,
       Text        => Lexer.Token_Buffer,
       Kind        => Kind);
    Lexer.Token_Buffer := UBW_Strings.Null_Unbounded_Wide_String;
  end Complete_Token;

  --
  -- Categorize Item into character class.
  --

  function Categorize_Character
    (Item : in Wide_Character) return Character_Class_t
  is
    Class : Character_Class_t := Ordinary_Text;
  begin
    case Item is
      when '('    => Class := List_Open_Delimiter;
      when ')'    => Class := List_Close_Delimiter;
      when '"'    => Class := String_Delimiter;
      when ';'    => Class := Comment_Delimiter;
      when '\'    => Class := Escape_Character;
      when others =>
        if Unicode.Is_Line_Terminator (Item) then
          Class := Line_Break;
        else
          if Unicode.Is_Space (Item) then
            Class := Whitespace;
          end if;
        end if;
    end case;
    return Class;
  end Categorize_Character;

  --
  -- Public API.
  --

  function Initialized (Lexer : in Lexer_t) return Boolean is
  begin
    return Lexer.Inited;
  end Initialized;

  --
  -- Initialize the lexer.
  --

  procedure Initialize_Lexer
    (Lexer  :    out Lexer_t;
     Status :    out Lexer_Status_t) is
  begin
    Lexer := Lexer_t'
      (Inited       => True,
       Current_Line => Line_Number_t'First,
       Token_Buffer => UBW_Strings.Null_Unbounded_Wide_String,
       Input_Buffer => Input_Buffer_t'(others => Wide_Character'Val (0)),
       State        => State_t'(others => False));
    Status       := Lexer_OK;
  end Initialize_Lexer;

  --
  -- Retrieve token from input stream.
  --

  procedure Get_Token
    (Lexer     : in out Lexer_t;
     Token     :    out Token_t;
     Status    :    out Lexer_Status_t)
  is
    --
    -- Stream characters via Read_Item.
    --
    procedure Fetch_Characters
      (Lexer     : in out Lexer_t;
       Item      :    out Wide_Character;
       Item_Next :    out Wide_Character;
       Status    :    out Stream_Status_t)
    is
      Null_Item : constant Wide_Character := Wide_Character'Val (0);
    begin
      if Lexer.Input_Buffer (Next) /= Null_Item then
        Lexer.Input_Buffer (Current) := Lexer.Input_Buffer (Next);
        Read_Item
          (Item   => Lexer.Input_Buffer (Next),
           Status => Status);
        case Status is
          when Stream_EOF   =>
            Lexer.Input_Buffer (Next) := Null_Item;
            Status                    := Stream_OK;
          when Stream_Error => null;
          when Stream_OK    => null;
        end case;
      else
        Read_Item
          (Item   => Lexer.Input_Buffer (Current),
           Status => Status);
        case Status is
          when Stream_EOF   => null;
          when Stream_Error => null;
          when Stream_OK    =>
            Read_Item
              (Item   => Lexer.Input_Buffer (Next),
               Status => Status);
            case Status is
              when Stream_EOF   =>
                Lexer.Input_Buffer (Next) := Null_Item;
                Status                    := Stream_OK;
              when Stream_Error => null;
              when Stream_OK    => null;
            end case;
        end case;
      end if;

      Item      := Lexer.Input_Buffer (Current);
      Item_Next := Lexer.Input_Buffer (Next);
    end Fetch_Characters;

    Item          : Wide_Character;
    Item_Next     : Wide_Character;
    Stream_Status : Stream_Status_t;
  begin
    -- Default status.
    Status := Lexer_Needs_More_Data;
    Token  := Invalid_Token;

    -- Fetch characters from input stream.
    Fetch_Characters
      (Lexer     => Lexer,
       Item      => Item,
       Item_Next => Item_Next,
       Status    => Stream_Status);
    case Stream_Status is
      when Stream_OK    => null;
      when Stream_Error =>
        Status := Lexer_Error_Stream_Error;
        return;
      when Stream_EOF   =>
        if State_Is_Set (Lexer, Inside_String) or
           State_Is_Set (Lexer, Inside_Escape) then
          Status := Lexer_Error_Early_EOF;
        else
          -- Reached upon EOF with no preceding newline/whitespace.
          Status := Lexer_OK;

          -- Have unfinished token?
          if Token_Is_Nonzero_Length (Lexer) then
            Complete_Token
              (Lexer => Lexer,
               Token => Token,
               Kind  => Token_Symbol);
          else
            Append_To_Token (Lexer, 'E');
            Complete_Token
              (Lexer => Lexer,
               Token => Token,
               Kind  => Token_EOF);
          end if;
        end if;
        return;
    end case;

    pragma Assert (Stream_Status = Stream_OK);

    -- Process character.
    case Categorize_Character (Item) is
      when Comment_Delimiter =>
        if State_Is_Set (Lexer, Inside_String) or
           State_Is_Set (Lexer, Inside_Escape) then
          Append_To_Token (Lexer, Item);
        else
          if not State_Is_Set (Lexer, Inside_Comment) then
            Set_State (Lexer, Inside_Comment);
          end if;
        end if;
      when Escape_Character =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          if State_Is_Set (Lexer, Inside_String) then
            if State_Is_Set (Lexer, Inside_Escape) then
              Append_To_Token (Lexer, Item);
              Unset_State (Lexer, Inside_Escape);
            else
              Set_State (Lexer, Inside_Escape);
            end if;
          end if;
        end if;
      when Line_Break =>
        if State_Is_Set (Lexer, Inside_Comment) then
          Unset_State (Lexer, Inside_Comment);
        else
          begin
            -- Potential overflow.
            Lexer.Current_Line := Lexer.Current_Line + 1;

            if State_Is_Set (Lexer, Inside_Escape) then
              Unset_State (Lexer, Inside_Escape);
            end if;
            if State_Is_Set (Lexer, Inside_String) then
              Append_To_Token (Lexer, Item);
            else
              if Token_Is_Nonzero_Length (Lexer) then
                Status := Lexer_OK;
                Complete_Token
                  (Lexer => Lexer,
                   Token => Token,
                   Kind  => Token_Symbol);
              end if;
            end if;
          exception
            when Constraint_Error =>
              Status := Lexer_Error_Line_Overflow;
              Token  := Invalid_Token;
          end;
        end if;
      when List_Open_Delimiter =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          Append_To_Token (Lexer, Item);
          if not State_Is_Set (Lexer, Inside_String) then
            Status := Lexer_OK;
            Complete_Token
              (Lexer => Lexer,
               Token => Token,
                Kind => Token_List_Open);
          end if;
        end if;
      when List_Close_Delimiter =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          Append_To_Token (Lexer, Item);
          if not State_Is_Set (Lexer, Inside_String) then
            Status := Lexer_OK;
            Complete_Token
              (Lexer => Lexer,
               Token => Token,
               Kind  => Token_List_Close);
          end if;
        end if;
      when String_Delimiter =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          if State_Is_Set (Lexer, Inside_String) then
            if State_Is_Set (Lexer, Inside_Escape) then
              Append_To_Token (Lexer, Item);
              Unset_State (Lexer, Inside_Escape);
            else
              Status := Lexer_OK;
              Complete_Token
                (Lexer => Lexer,
                 Token => Token,
                 Kind  => Token_Quoted_String);
              Unset_State (Lexer, Inside_String);
            end if;
          else
            Set_State (Lexer, Inside_String);
          end if;
        end if;
      when Whitespace =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          if State_Is_Set (Lexer, Inside_Escape) then
            Unset_State (Lexer, Inside_Escape);
          end if;
          if State_Is_Set (Lexer, Inside_String) then
            Append_To_Token (Lexer, Item);
          else
            if Token_Is_Nonzero_Length (Lexer) then
              Status := Lexer_OK;
              Complete_Token
                (Lexer => Lexer,
                 Token => Token,
                 Kind  => Token_Symbol);
            end if;
          end if;
        end if;
      when Ordinary_Text =>
        if not State_Is_Set (Lexer, Inside_Comment) then
          if State_Is_Set (Lexer, Inside_Escape) then
            Unset_State (Lexer, Inside_Escape);
          end if;
          Append_To_Token (Lexer, Item);

          -- End of token if not inside a string.
          case Categorize_Character (Item_Next) is
            when List_Open_Delimiter | List_Close_Delimiter | String_Delimiter =>
              if not State_Is_Set (Lexer, Inside_String) then
                Status := Lexer_OK;
                Complete_Token
                  (Lexer => Lexer,
                   Token => Token,
                   Kind  => Token_Symbol);
              end if;
            when others => null;
          end case;
        end if;
    end case;
  exception
    when Storage_Error =>
      Status := Lexer_Error_Out_Of_Memory;
      Token  := Invalid_Token;
  end Get_Token;

end Symbex.Lex;

Fix input stream on edge-case EOF.

Fix input stream on edge-case EOF.


-----------------------------------------------------------------------
--  gen-generator -- Code Generator
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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.Command_Line;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Hashed_Maps;

with Util.Beans.Objects;
with Util.Properties;

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

with Gen.Model.Packages;
with Gen.Model.Projects;
with Gen.Artifacts.Hibernate;
with Gen.Artifacts.Query;
with Gen.Artifacts.Mappings;
with Gen.Artifacts.Distribs;
with Gen.Artifacts.XMI;
with Gen.Artifacts.Yaml;
package Gen.Generator is

   package UBO renames Util.Beans.Objects;

   --  A fatal error that prevents the generator to proceed has occurred.
   Fatal_Error : exception;

   G_URI : constant String := "http://code.google.com/p/ada-ado/generator";

   type Package_Type is (PACKAGE_MODEL, PACKAGE_FORMS);

   type Mapping_File is record
      Path   : UString;
      Output : Ada.Text_IO.File_Type;
   end record;

   type Handler is new ASF.Applications.Main.Application and Gen.Artifacts.Generator with private;

   --  Initialize the generator
   procedure Initialize (H : in out Handler;
                         Config_Dir : in UString;
                         Debug : in Boolean);

   --  Get the configuration properties.
   function Get_Properties (H : in Handler) return Util.Properties.Manager;

   --  Report an error and set the exit status accordingly
   procedure Error (H : in out Handler;
                    Message : in String;
                    Arg1    : in String;
                    Arg2    : in String := "");

   overriding
   procedure Error (H       : in out Handler;
                    Message : in String);

   --  Report an info message.
   procedure Info (H : in out Handler;
                   Message : in String;
                   Arg1    : in String := "";
                   Arg2    : in String := "";
                   Arg3    : in String := "");

   --  Read the XML package file
   procedure Read_Package (H    : in out Handler;
                           File : in String);

   --  Read the model mapping types and initialize the hibernate artifact.
   procedure Read_Mappings (H    : in out Handler);

   --  Read the XML model file
   procedure Read_Model (H      : in out Handler;
                         File   : in String;
                         Silent : in Boolean);

   --  Read the model and query files stored in the application directory db.
   procedure Read_Models (H : in out Handler;
                          Dirname : in String);

   --  Read the XML project file.  When Recursive is set, read the GNAT project
   --  files used by the main project and load all the dynamo.xml files defined
   --  by these project.
   procedure Read_Project (H         : in out Handler;
                           File      : in String;
                           Recursive : in Boolean := False);

   --  Prepare the model by checking, verifying and initializing it after it is completely known.
   procedure Prepare (H : in out Handler);

   --  Finish the generation.  Some artifacts could generate other files that take into
   --  account files generated previously.
   procedure Finish (H : in out Handler);

   --  Tell the generator to activate the generation of the given template name.
   --  The name is a property name that must be defined in generator.properties to
   --  indicate the template file.  Several artifacts can trigger the generation
   --  of a given template.  The template is generated only once.
   procedure Add_Generation (H    : in out Handler;
                             Name : in String;
                             Mode : in Gen.Artifacts.Iteration_Mode;
                             Mapping : in String);

   --  Enable the generation of the Ada package given by the name.  By default all the Ada
   --  packages found in the model are generated.  When called, this enables the generation
   --  only for the Ada packages registered here.
   procedure Enable_Package_Generation (H    : in out Handler;
                                        Name : in String);

   --  Save the content generated by the template generator.
   procedure Save_Content (H       : in out Handler;
                           File    : in String;
                           Content : in UString);

   --  Generate the code using the template file
   procedure Generate (H     : in out Handler;
                       Mode  : in Gen.Artifacts.Iteration_Mode;
                       File  : in String;
                       Save  : not null access
                         procedure (H       : in out Handler;
                                    File    : in String;
                                    Content : in UString));

   --  Generate the code using the template file
   procedure Generate (H     : in out Handler;
                       File  : in String;
                       Model : in Gen.Model.Definition_Access;
                       Save  : not null access
                         procedure (H       : in out Handler;
                                    File    : in String;
                                    Content : in UString));

   --  Generate all the code for the templates activated through Add_Generation.
   procedure Generate_All (H    : in out Handler);

   --  Generate all the code generation files stored in the directory
   procedure Generate_All (H    : in out Handler;
                           Mode : in Gen.Artifacts.Iteration_Mode;
                           Name : in String);

   --  Set the directory where template files are stored.
   procedure Set_Template_Directory (H    : in out Handler;
                                     Path : in UString);

   --  Set the directory where results files are generated.
   procedure Set_Result_Directory (H    : in out Handler;
                                   Path : in String);

   --  Get the result directory path.
   function Get_Result_Directory (H : in Handler) return String;

   --  Get the project plugin directory path.
   function Get_Plugin_Directory (H : in Handler) return String;

   --  Get the config directory path.
   function Get_Config_Directory (H : in Handler) return String;

   --  Get the dynamo installation directory path.
   function Get_Install_Directory (H : in Handler) return String;

   --  Return the search directories that the AWA application can use to find files.
   --  The search directories is built by using the project dependencies.
   function Get_Search_Directories (H : in Handler) return String;

   --  Get the exit status
   --  Returns 0 if the generation was successful
   --  Returns 1 if there was a generation error
   function Get_Status (H : in Handler) return Ada.Command_Line.Exit_Status;

   --  Get the configuration parameter.
   function Get_Parameter (H       : in Handler;
                           Name    : in String;
                           Default : in String := "") return String;

   --  Get the configuration parameter.
   function Get_Parameter (H       : in Handler;
                           Name    : in String;
                           Default : in Boolean := False) return Boolean;

   --  Set the force-save file mode.  When False, if the generated file exists already,
   --  an error message is reported.
   procedure Set_Force_Save (H  : in out Handler;
                             To : in Boolean);

   --  Set the project name.
   procedure Set_Project_Name (H    : in out Handler;
                               Name : in String);

   --  Get the project name.
   function Get_Project_Name (H : in Handler) return String;

   --  Set the project property.
   procedure Set_Project_Property (H     : in out Handler;
                                   Name  : in String;
                                   Value : in String);

   --  Get the project property identified by the given name.  If the project property
   --  does not exist, returns the default value.  Project properties are loaded
   --  by Read_Project.
   function Get_Project_Property (H       : in Handler;
                                  Name    : in String;
                                  Default : in String := "") return String;

   --  Save the project description and parameters.
   procedure Save_Project (H : in out Handler);

   --  Get the path of the last generated file.
   function Get_Generated_File (H : in Handler) return String;

   --  Update the project model through the Process procedure.
   procedure Update_Project (H : in out Handler;
                             Process : not null access
                               procedure (P : in out Model.Projects.Root_Project_Definition));

   --  Scan the dynamo directories and execute the Process procedure with the
   --  directory path.
   procedure Scan_Directories (H : in Handler;
                               Process : not null access
                                 procedure (Dir : in String));

private

   use Ada.Strings.Unbounded;
   use Gen.Artifacts;

   type Template_Context is record
      Mode    : Gen.Artifacts.Iteration_Mode;
      Mapping : UString;
   end record;

   package Template_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => UString,
                                     Element_Type    => Template_Context,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   type Object_Access is access all UBO.Object;

   type Handler is new ASF.Applications.Main.Application and Gen.Artifacts.Generator with record
      Conf       : ASF.Applications.Config;

      --  Config directory.
      Config_Dir : UString;

      --  Output base directory.
      Output_Dir : UString;

      Model  : aliased Gen.Model.Packages.Model_Definition;
      Status : Ada.Command_Line.Exit_Status := 0;

      --  The file that must be saved (the file attribute in <f:view>.
      File     : Object_Access;

      --  Indicates whether the file must be saved at each generation or only once.
      --  This is the mode attribute in <f:view>.
      Mode     : Object_Access;

      --  Indicates whether the file must be ignored after the generation.
      --  This is the ignore attribute in <f:view>.  It is intended to be used for the package
      --  body generation to skip that in some cases when it turns out there is no operation.
      Ignore   : Object_Access;

      --  Whether the AdaMappings.xml file was loaded or not.
      Type_Mapping_Loaded : Boolean := False;

      --  The root project document.
      Project : aliased Gen.Model.Projects.Root_Project_Definition;

      --  Hibernate XML artifact
      Hibernate : Gen.Artifacts.Hibernate.Artifact;

      --  Query generation artifact.
      Query     : Gen.Artifacts.Query.Artifact;

      --  Type mapping artifact.
      Mappings  : Gen.Artifacts.Mappings.Artifact;

      --  The distribution artifact.
      Distrib   : Gen.Artifacts.Distribs.Artifact;

      --  Ada generation from UML-XMI models.
      XMI       : Gen.Artifacts.XMI.Artifact;

      --  Yaml model files support.
      Yaml      : Gen.Artifacts.Yaml.Artifact;

      --  The list of templates that must be generated.
      Templates : Template_Map.Map;

      --  Force the saving of a generated file, even if a file already exist.
      Force_Save : Boolean := True;

      --  A fake servlet for template evaluation.
      Servlet    : ASF.Servlets.Servlet_Access;
   end record;

   --  Execute the lifecycle phases on the faces context.
   overriding
   procedure Execute_Lifecycle (App     : in Handler;
                                Context : in out ASF.Contexts.Faces.Faces_Context'Class);

end Gen.Generator;

-----------------------------------------------------------------------
--  gen-generator -- Code Generator
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015, 2018, 2022 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 Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Hashed_Maps;

with Util.Beans.Objects;
with Util.Properties;

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

with Gen.Model.Packages;
with Gen.Model.Projects;
with Gen.Artifacts.Hibernate;
with Gen.Artifacts.Query;
with Gen.Artifacts.Mappings;
with Gen.Artifacts.Distribs;
with Gen.Artifacts.XMI;
with Gen.Artifacts.Yaml;
package Gen.Generator is

   package UBO renames Util.Beans.Objects;

   --  A fatal error that prevents the generator to proceed has occurred.
   Fatal_Error : exception;

   G_URI : constant String := "http://code.google.com/p/ada-ado/generator";

   type Package_Type is (PACKAGE_MODEL, PACKAGE_FORMS);

   type Mapping_File is record
      Path   : UString;
      Output : Ada.Text_IO.File_Type;
   end record;

   type Handler is new ASF.Applications.Main.Application and Gen.Artifacts.Generator with private;

   --  Initialize the generator
   procedure Initialize (H : in out Handler;
                         Config_Dir : in UString;
                         Debug : in Boolean);

   --  Get the configuration properties.
   function Get_Properties (H : in Handler) return Util.Properties.Manager;

   --  Report an error and set the exit status accordingly
   procedure Error (H : in out Handler;
                    Message : in String;
                    Arg1    : in String;
                    Arg2    : in String := "");

   overriding
   procedure Error (H       : in out Handler;
                    Message : in String);

   --  Report an info message.
   procedure Info (H : in out Handler;
                   Message : in String;
                   Arg1    : in String := "";
                   Arg2    : in String := "";
                   Arg3    : in String := "");

   --  Read the XML package file
   procedure Read_Package (H    : in out Handler;
                           File : in String);

   --  Read the model mapping types and initialize the hibernate artifact.
   procedure Read_Mappings (H    : in out Handler);

   --  Read the XML model file
   procedure Read_Model (H      : in out Handler;
                         File   : in String;
                         Silent : in Boolean);

   --  Read the model and query files stored in the application directory db.
   procedure Read_Models (H : in out Handler;
                          Dirname : in String);

   --  Read the XML project file.  When Recursive is set, read the GNAT project
   --  files used by the main project and load all the dynamo.xml files defined
   --  by these project.
   procedure Read_Project (H         : in out Handler;
                           File      : in String;
                           Recursive : in Boolean := False);

   --  Prepare the model by checking, verifying and initializing it after it is completely known.
   procedure Prepare (H : in out Handler);

   --  Finish the generation.  Some artifacts could generate other files that take into
   --  account files generated previously.
   procedure Finish (H : in out Handler);

   --  Tell the generator to activate the generation of the given template name.
   --  The name is a property name that must be defined in generator.properties to
   --  indicate the template file.  Several artifacts can trigger the generation
   --  of a given template.  The template is generated only once.
   procedure Add_Generation (H    : in out Handler;
                             Name : in String;
                             Mode : in Gen.Artifacts.Iteration_Mode;
                             Mapping : in String);

   --  Enable the generation of the Ada package given by the name.  By default all the Ada
   --  packages found in the model are generated.  When called, this enables the generation
   --  only for the Ada packages registered here.
   procedure Enable_Package_Generation (H    : in out Handler;
                                        Name : in String);

   --  Save the content generated by the template generator.
   procedure Save_Content (H       : in out Handler;
                           File    : in String;
                           Content : in UString);

   --  Generate the code using the template file
   procedure Generate (H     : in out Handler;
                       Mode  : in Gen.Artifacts.Iteration_Mode;
                       File  : in String;
                       Save  : not null access
                         procedure (H       : in out Handler;
                                    File    : in String;
                                    Content : in UString));

   --  Generate the code using the template file
   procedure Generate (H     : in out Handler;
                       File  : in String;
                       Model : in Gen.Model.Definition_Access;
                       Save  : not null access
                         procedure (H       : in out Handler;
                                    File    : in String;
                                    Content : in UString));

   --  Generate all the code for the templates activated through Add_Generation.
   procedure Generate_All (H    : in out Handler);

   --  Generate all the code generation files stored in the directory
   procedure Generate_All (H    : in out Handler;
                           Mode : in Gen.Artifacts.Iteration_Mode;
                           Name : in String);

   --  Set the directory where template files are stored.
   procedure Set_Template_Directory (H    : in out Handler;
                                     Path : in UString);

   --  Set the directory where results files are generated.
   procedure Set_Result_Directory (H    : in out Handler;
                                   Path : in String);

   --  Get the result directory path.
   function Get_Result_Directory (H : in Handler) return String;

   --  Get the project plugin directory path.
   function Get_Plugin_Directory (H : in Handler) return String;

   --  Get the config directory path.
   function Get_Config_Directory (H : in Handler) return String;

   --  Get the dynamo installation directory path.
   function Get_Install_Directory (H : in Handler) return String;

   --  Return the search directories that the AWA application can use to find files.
   --  The search directories is built by using the project dependencies.
   function Get_Search_Directories (H : in Handler) return String;

   --  Get the exit status
   --  Returns 0 if the generation was successful
   --  Returns 1 if there was a generation error
   function Get_Status (H : in Handler) return Ada.Command_Line.Exit_Status;

   --  Get the configuration parameter.
   function Get_Parameter (H       : in Handler;
                           Name    : in String;
                           Default : in String := "") return String;

   --  Get the configuration parameter.
   function Get_Parameter (H       : in Handler;
                           Name    : in String;
                           Default : in Boolean := False) return Boolean;

   --  Set the force-save file mode.  When False, if the generated file exists already,
   --  an error message is reported.
   procedure Set_Force_Save (H  : in out Handler;
                             To : in Boolean);

   --  Set the project name.
   procedure Set_Project_Name (H    : in out Handler;
                               Name : in String);

   --  Get the project name.
   function Get_Project_Name (H : in Handler) return String;

   --  Set the project property.
   procedure Set_Project_Property (H     : in out Handler;
                                   Name  : in String;
                                   Value : in String);

   --  Get the project property identified by the given name.  If the project property
   --  does not exist, returns the default value.  Project properties are loaded
   --  by Read_Project.
   function Get_Project_Property (H       : in Handler;
                                  Name    : in String;
                                  Default : in String := "") return String;

   --  Set the global configuration identified by the name by pre-pending the
   --  environtment variable if it is defined.
   procedure Set_Configuration (H        : in out Handler;
                                Name     : in String;
                                Env_Name : in String);

   --  Save the project description and parameters.
   procedure Save_Project (H : in out Handler);

   --  Get the path of the last generated file.
   function Get_Generated_File (H : in Handler) return String;

   --  Update the project model through the Process procedure.
   procedure Update_Project (H : in out Handler;
                             Process : not null access
                               procedure (P : in out Model.Projects.Root_Project_Definition));

   --  Scan the dynamo directories and execute the Process procedure with the
   --  directory path.
   procedure Scan_Directories (H : in Handler;
                               Process : not null access
                                 procedure (Dir : in String));

private

   use Ada.Strings.Unbounded;
   use Gen.Artifacts;

   type Template_Context is record
      Mode    : Gen.Artifacts.Iteration_Mode;
      Mapping : UString;
   end record;

   package Template_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => UString,
                                     Element_Type    => Template_Context,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   type Object_Access is access all UBO.Object;

   type Handler is new ASF.Applications.Main.Application and Gen.Artifacts.Generator with record
      Conf       : ASF.Applications.Config;

      --  Config directory.
      Config_Dir : UString;

      --  Output base directory.
      Output_Dir : UString;

      Model  : aliased Gen.Model.Packages.Model_Definition;
      Status : Ada.Command_Line.Exit_Status := 0;

      --  The file that must be saved (the file attribute in <f:view>.
      File     : Object_Access;

      --  Indicates whether the file must be saved at each generation or only once.
      --  This is the mode attribute in <f:view>.
      Mode     : Object_Access;

      --  Indicates whether the file must be ignored after the generation.
      --  This is the ignore attribute in <f:view>.  It is intended to be used for the package
      --  body generation to skip that in some cases when it turns out there is no operation.
      Ignore   : Object_Access;

      --  Whether the AdaMappings.xml file was loaded or not.
      Type_Mapping_Loaded : Boolean := False;

      --  The root project document.
      Project : aliased Gen.Model.Projects.Root_Project_Definition;

      --  Hibernate XML artifact
      Hibernate : Gen.Artifacts.Hibernate.Artifact;

      --  Query generation artifact.
      Query     : Gen.Artifacts.Query.Artifact;

      --  Type mapping artifact.
      Mappings  : Gen.Artifacts.Mappings.Artifact;

      --  The distribution artifact.
      Distrib   : Gen.Artifacts.Distribs.Artifact;

      --  Ada generation from UML-XMI models.
      XMI       : Gen.Artifacts.XMI.Artifact;

      --  Yaml model files support.
      Yaml      : Gen.Artifacts.Yaml.Artifact;

      --  The list of templates that must be generated.
      Templates : Template_Map.Map;

      --  Force the saving of a generated file, even if a file already exist.
      Force_Save : Boolean := True;

      --  A fake servlet for template evaluation.
      Servlet    : ASF.Servlets.Servlet_Access;
   end record;

   --  Execute the lifecycle phases on the faces context.
   overriding
   procedure Execute_Lifecycle (App     : in Handler;
                                Context : in out ASF.Contexts.Faces.Faces_Context'Class);

end Gen.Generator;

Declare the Set_Configuration procedure

Declare the Set_Configuration procedure


-----------------------------------------------------------------------
--  awa-users-principals -- User principals
--  Copyright (C) 2011 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.
-----------------------------------------------------------------------

package body AWA.Users.Principals is

   --  ------------------------------
   --  Get the principal name.
   --  ------------------------------
   function Get_Name (From : in Principal) return String is
   begin
      return From.User.Get_Name;
   end Get_Name;

   --  ------------------------------
   --  Returns true if the given role is stored in the user principal.
   --  ------------------------------
--     function Has_Role (User : in Principal;
--                        Role : in Security.Permissions.Role_Type) return Boolean is
--     begin
--        return User.Roles (Role);
--     end Has_Role;

   --  ------------------------------
   --  Get the principal identifier (name)
   --  ------------------------------
   function Get_Id (From : in Principal) return String is
   begin
      return From.User.Get_Name;
   end Get_Id;

   --  ------------------------------
   --  Get the user associated with the principal.
   --  ------------------------------
   function Get_User (From : in Principal) return AWA.Users.Models.User_Ref is
   begin
      return From.User;
   end Get_User;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none.
   --  ------------------------------
   function Get_User_Identifier (From : in Principal) return ADO.Identifier is
   begin
      return From.User.Get_Id;
   end Get_User_Identifier;

   --  ------------------------------
   --  Get the connection session used by the user.
   --  ------------------------------
   function Get_Session (From : in Principal) return AWA.Users.Models.Session_Ref is
   begin
      return From.Session;
   end Get_Session;

   --  ------------------------------
   --  Get the connection session identifier used by the user.
   --  ------------------------------
   function Get_Session_Identifier (From : in Principal) return ADO.Identifier is
   begin
      return From.Session.Get_Id;
   end Get_Session_Identifier;

   --  ------------------------------
   --  Create a principal for the given user.
   --  ------------------------------
   function Create (User    : in AWA.Users.Models.User_Ref;
                    Session : in AWA.Users.Models.Session_Ref) return Principal_Access is
      Result : constant Principal_Access := new Principal;
   begin
      Result.User    := User;
	  Result.Session := Session;
      return Result;
   end Create;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none or if the principal is not an AWA principal.
   --  ------------------------------
   function Get_User_Identifier (From : in ASF.Principals.Principal_Access)
                                 return ADO.Identifier is
      use type ASF.Principals.Principal_Access;
   begin
      if From = null then
         return ADO.NO_IDENTIFIER;

      elsif not (From.all in Principal'Class) then
         return ADO.NO_IDENTIFIER;

      else
         return Principal'Class (From.all).Get_User_Identifier;
      end if;
   end Get_User_Identifier;

end AWA.Users.Principals;

-----------------------------------------------------------------------
--  awa-users-principals -- User principals
--  Copyright (C) 2011, 2012, 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.
-----------------------------------------------------------------------

package body AWA.Users.Principals is

   --  ------------------------------
   --  Get the principal name.
   --  ------------------------------
   function Get_Name (From : in Principal) return String is
   begin
      return From.User.Get_Name;
   end Get_Name;

   --  ------------------------------
   --  Get the principal identifier (name)
   --  ------------------------------
   function Get_Id (From : in Principal) return String is
   begin
      return From.User.Get_Name;
   end Get_Id;

   --  ------------------------------
   --  Get the user associated with the principal.
   --  ------------------------------
   function Get_User (From : in Principal) return AWA.Users.Models.User_Ref is
   begin
      return From.User;
   end Get_User;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none.
   --  ------------------------------
   function Get_User_Identifier (From : in Principal) return ADO.Identifier is
   begin
      return From.User.Get_Id;
   end Get_User_Identifier;

   --  ------------------------------
   --  Get the connection session used by the user.
   --  ------------------------------
   function Get_Session (From : in Principal) return AWA.Users.Models.Session_Ref is
   begin
      return From.Session;
   end Get_Session;

   --  ------------------------------
   --  Get the connection session identifier used by the user.
   --  ------------------------------
   function Get_Session_Identifier (From : in Principal) return ADO.Identifier is
   begin
      return From.Session.Get_Id;
   end Get_Session_Identifier;

   --  ------------------------------
   --  Create a principal for the given user.
   --  ------------------------------
   function Create (User    : in AWA.Users.Models.User_Ref;
                    Session : in AWA.Users.Models.Session_Ref) return Principal_Access is
      Result : constant Principal_Access := new Principal;
   begin
      Result.User    := User;
      Result.Session := Session;
      return Result;
   end Create;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none or if the principal is not an AWA principal.
   --  ------------------------------
   function Get_User_Identifier (From : in ASF.Principals.Principal_Access)
                                 return ADO.Identifier is
      use type ASF.Principals.Principal_Access;
   begin
      if From = null then
         return ADO.NO_IDENTIFIER;

      elsif not (From.all in Principal'Class) then
         return ADO.NO_IDENTIFIER;

      else
         return Principal'Class (From.all).Get_User_Identifier;
      end if;
   end Get_User_Identifier;

end AWA.Users.Principals;

Fix compilation warnings

Fix compilation warnings