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

with Ada.Finalization;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Containers.Indefinite_Hashed_Maps;

with Util.Log.Loggers;
with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Serialize.IO;
with Util.Listeners;

with EL.Expressions;

with ASF.Beans;
with ASF.Applications;
with ADO.Sessions;

with AWA.Events;
limited with AWA.Applications;

--  == Introduction ==
--  A module is a software component that can be integrated in the
--  web application.  The module can bring a set of service APIs,
--  some Ada beans and some presentation files.  The AWA framework
--  allows to configure various parts of a module when it is integrated
--  in an application.  Some modules are designed to be re-used by
--  several applications (for example a _mail_ module, a _users_
--  module, ...).  Other modules could be specific to an application.
--  An application will be made of several modules, some will be
--  generic some others specific to the application.
--
--  == Registration ==
--  The module should have only one instance per application and it must
--  be registered when the application is initialized.  The module
--  instance should be added to the application record as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Xxx       : aliased Xxx_Module;
--    end record;
--
--  The application record must override the `Initialize_Module` procedure
--  and it must register the module instance.  This is done as follows:
--
--    overriding
--    procedure Initialize_Modules (App : in out Application) is
--    begin
--       Register (App    => App.Self.all'Access,
--                 Name   => Xxx.Module.NAME,
--                 URI    => "xxx",
--                 Module => App.User_Module'Access);
--    end Initialize_Modules;
--
--  The module is registered under a unique name.  That name is used
--  to load the module configuration.
--
--  == Configuration ==
--  The module is configured by using an XML or a properties file.
--  The configuration file is used to define:
--
--    * the Ada beans that the module defines and uses,
--    * the events that the module wants to receive and the action
--      that must be performed when the event is posted,
--    * the permissions that the module needs and how to check them,
--    * the navigation rules which are used for the module web interface,
--    * the servlet and filter mappings used by the module
--
--  The module configuration is located in the *config* directory
--  and must be the name of the module followed by the file extension
--  (example: `module-name`.xml or `module-name`.properties).
--
--
package AWA.Modules is

   type Application_Access is access all AWA.Applications.Application'Class;

   --  ------------------------------
   --  Module manager
   --  ------------------------------
   --
   --  The Module_Manager represents the root of the logic manager
   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with private;

   function Get_Value (Manager : in Module_Manager;
                       Name    : in String) return Util.Beans.Objects.Object;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module_Manager;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module_Manager;
                        Config : in ASF.Applications.Config_Param) return String;

   --  ------------------------------
   --  Module
   --  ------------------------------
   type Module is abstract new Ada.Finalization.Limited_Controlled with private;
   type Module_Access is access all Module'Class;

   --  Get the module name
   function Get_Name (Plugin : Module) return String;

   --  Get the base URI for this module
   function Get_URI (Plugin : Module) return String;

   --  Get the application in which this module is registered.
   function Get_Application (Plugin : in Module) return Application_Access;

   --  Find the module with the given name
   function Find_Module (Plugin : Module;
                         Name   : String) return Module_Access;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : Integer := -1) return Integer;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module;
                        Config : in ASF.Applications.Config_Param) return String;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : in Module;
                        Name    : in String;
                        Default : in String := "")
                        return EL.Expressions.Expression;

   procedure Initialize (Manager : in out Module_Manager;
                         Module  : in AWA.Modules.Module'Class);

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Initialize the configuration file parser represented by Parser to recognize
   --  the specific configuration recognized by the module.
   procedure Initialize_Parser (Plugin : in out Module;
                                Parser : in out Util.Serialize.IO.Parser'Class) is null;

   --  Configures the module after its initialization and after having read its XML configuration.
   procedure Configure (Plugin : in out Module;
                        Props  : in ASF.Applications.Config) is null;

   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Plugin  : in Module;
                         Content : in AWA.Events.Module_Event'Class);

   --  Get the database connection for reading
   function Get_Session (Manager : Module)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module)
                                return ADO.Sessions.Master_Session;

   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   procedure Register (Plugin : in out Module;
                       Name    : in String;
                       Bind    : in ASF.Beans.Class_Binding_Access);

   --  Add a listener to the module listner list.  The module will invoke the listner
   --  depending on events or actions that occur in the module.
   procedure Add_Listener (Into : in out Module;
                           Item : in Util.Listeners.Listener_Access);

   --  Find the module with the given name in the application and add the listener to the
   --  module listener list.
   procedure Add_Listener (Plugin : in Module;
                           Name   : in String;
                           Item   : in Util.Listeners.Listener_Access);

   --  Remove a listener from the module listener list.
   procedure Remove_Listener (Into : in out Module;
                              Item : in Util.Listeners.Listener_Access);

   --  Finalize the module.
   overriding
   procedure Finalize (Plugin : in out Module);

   type Pool_Module is abstract new Module with private;

   type Session_Module is abstract new Module with private;

   generic
      type Manager_Type is new Module_Manager with private;
      type Manager_Type_Access is access all Manager_Type'Class;
      Name : String;
   function Get_Manager return Manager_Type_Access;

   --  Get the database connection for reading
   function Get_Session (Manager : Module_Manager)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module_Manager)
                                return ADO.Sessions.Master_Session;

   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Manager : in Module_Manager;
                         Content : in AWA.Events.Module_Event'Class);

   --  ------------------------------
   --  Module Registry
   --  ------------------------------
   --  The module registry maintains the list of available modules with
   --  operations to retrieve them either from a name or from the base URI.
   type Module_Registry is limited private;
   type Module_Registry_Access is access all Module_Registry;

   --  Initialize the registry
   procedure Initialize (Registry : in out Module_Registry;
                         Config   : in ASF.Applications.Config);

   --  Register the module in the registry.
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String);

   --  Find the module with the given name
   function Find_By_Name (Registry : Module_Registry;
                          Name     : String) return Module_Access;

   --  Find the module mapped to a given URI
   function Find_By_URI (Registry : Module_Registry;
                         URI      : String) return Module_Access;

   --  Iterate over the modules that have been registered and execute the Process
   --  procedure on each of the module instance.
   procedure Iterate (Registry : in Module_Registry;
                      Process  : access procedure (Plugin : in out Module'Class));

private

   use Ada.Strings.Unbounded;

   type Module is abstract new Ada.Finalization.Limited_Controlled with record
      Registry   : Module_Registry_Access;
      App        : Application_Access := null;
      Name       : Unbounded_String;
      URI        : Unbounded_String;
      Config     : ASF.Applications.Config;
      Self       : Module_Access := null;
      Listeners  : Util.Listeners.List;
   end record;

   --  Map to find a module from its name or its URI
   package Module_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                            Element_Type    => Module_Access,
                                            Hash            => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   type Module_Registry is limited record
      Config   : ASF.Applications.Config;
      Name_Map : Module_Maps.Map;
      URI_Map  : Module_Maps.Map;
   end record;

   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with record
      Module : Module_Access := null;
   end record;

   type Pool_Module is new Module with record
      D : Natural;
   end record;

   type Session_Module is new Module with record
      P : Natural;
   end record;

   use Util.Log;

   --  The logger (used by the generic Get function).
   Log : constant Loggers.Logger := Loggers.Create ("AWA.Modules");

end AWA.Modules;

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

with Ada.Finalization;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Containers.Indefinite_Hashed_Maps;

with Util.Log.Loggers;
with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Serialize.IO;
with Util.Listeners;

with EL.Expressions;

with ASF.Beans;
with ASF.Applications;
with ADO.Sessions;

with AWA.Events;
limited with AWA.Applications;

--  == Introduction ==
--  A module is a software component that can be integrated in the
--  web application.  The module can bring a set of service APIs,
--  some Ada beans and some presentation files.  The AWA framework
--  allows to configure various parts of a module when it is integrated
--  in an application.  Some modules are designed to be re-used by
--  several applications (for example a _mail_ module, a _users_
--  module, ...).  Other modules could be specific to an application.
--  An application will be made of several modules, some will be
--  generic some others specific to the application.
--
--  == Registration ==
--  The module should have only one instance per application and it must
--  be registered when the application is initialized.  The module
--  instance should be added to the application record as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Xxx       : aliased Xxx_Module;
--    end record;
--
--  The application record must override the `Initialize_Module` procedure
--  and it must register the module instance.  This is done as follows:
--
--    overriding
--    procedure Initialize_Modules (App : in out Application) is
--    begin
--       Register (App    => App.Self.all'Access,
--                 Name   => Xxx.Module.NAME,
--                 URI    => "xxx",
--                 Module => App.User_Module'Access);
--    end Initialize_Modules;
--
--  The module is registered under a unique name.  That name is used
--  to load the module configuration.
--
--  == Configuration ==
--  The module is configured by using an XML or a properties file.
--  The configuration file is used to define:
--
--    * the Ada beans that the module defines and uses,
--    * the events that the module wants to receive and the action
--      that must be performed when the event is posted,
--    * the permissions that the module needs and how to check them,
--    * the navigation rules which are used for the module web interface,
--    * the servlet and filter mappings used by the module
--
--  The module configuration is located in the *config* directory
--  and must be the name of the module followed by the file extension
--  (example: `module-name`.xml or `module-name`.properties).
--
--
package AWA.Modules is

   type Application_Access is access all AWA.Applications.Application'Class;

   --  ------------------------------
   --  Module manager
   --  ------------------------------
   --
   --  The Module_Manager represents the root of the logic manager
   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with private;

   function Get_Value (Manager : in Module_Manager;
                       Name    : in String) return Util.Beans.Objects.Object;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module_Manager;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module_Manager;
                        Config : in ASF.Applications.Config_Param) return String;

   --  ------------------------------
   --  Module
   --  ------------------------------
   type Module is abstract new Ada.Finalization.Limited_Controlled with private;
   type Module_Access is access all Module'Class;

   --  Get the module name
   function Get_Name (Plugin : Module) return String;

   --  Get the base URI for this module
   function Get_URI (Plugin : Module) return String;

   --  Get the application in which this module is registered.
   function Get_Application (Plugin : in Module) return Application_Access;

   --  Find the module with the given name
   function Find_Module (Plugin : Module;
                         Name   : String) return Module_Access;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : Integer := -1) return Integer;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : Boolean := False) return Boolean;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module;
                        Config : in ASF.Applications.Config_Param) return String;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : in Module;
                        Name    : in String;
                        Default : in String := "")
                        return EL.Expressions.Expression;

   procedure Initialize (Manager : in out Module_Manager;
                         Module  : in AWA.Modules.Module'Class);

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Initialize the configuration file parser represented by Parser to recognize
   --  the specific configuration recognized by the module.
   procedure Initialize_Parser (Plugin : in out Module;
                                Parser : in out Util.Serialize.IO.Parser'Class) is null;

   --  Configures the module after its initialization and after having read its XML configuration.
   procedure Configure (Plugin : in out Module;
                        Props  : in ASF.Applications.Config) is null;

   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Plugin  : in Module;
                         Content : in AWA.Events.Module_Event'Class);

   --  Get the database connection for reading
   function Get_Session (Manager : Module)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module)
                                return ADO.Sessions.Master_Session;

   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   procedure Register (Plugin : in out Module;
                       Name    : in String;
                       Bind    : in ASF.Beans.Class_Binding_Access);

   --  Add a listener to the module listner list.  The module will invoke the listner
   --  depending on events or actions that occur in the module.
   procedure Add_Listener (Into : in out Module;
                           Item : in Util.Listeners.Listener_Access);

   --  Find the module with the given name in the application and add the listener to the
   --  module listener list.
   procedure Add_Listener (Plugin : in Module;
                           Name   : in String;
                           Item   : in Util.Listeners.Listener_Access);

   --  Remove a listener from the module listener list.
   procedure Remove_Listener (Into : in out Module;
                              Item : in Util.Listeners.Listener_Access);

   --  Finalize the module.
   overriding
   procedure Finalize (Plugin : in out Module);

   type Pool_Module is abstract new Module with private;

   type Session_Module is abstract new Module with private;

   generic
      type Manager_Type is new Module_Manager with private;
      type Manager_Type_Access is access all Manager_Type'Class;
      Name : String;
   function Get_Manager return Manager_Type_Access;

   --  Get the database connection for reading
   function Get_Session (Manager : Module_Manager)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module_Manager)
                                return ADO.Sessions.Master_Session;

   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Manager : in Module_Manager;
                         Content : in AWA.Events.Module_Event'Class);

   --  ------------------------------
   --  Module Registry
   --  ------------------------------
   --  The module registry maintains the list of available modules with
   --  operations to retrieve them either from a name or from the base URI.
   type Module_Registry is limited private;
   type Module_Registry_Access is access all Module_Registry;

   --  Initialize the registry
   procedure Initialize (Registry : in out Module_Registry;
                         Config   : in ASF.Applications.Config);

   --  Register the module in the registry.
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String);

   --  Find the module with the given name
   function Find_By_Name (Registry : Module_Registry;
                          Name     : String) return Module_Access;

   --  Find the module mapped to a given URI
   function Find_By_URI (Registry : Module_Registry;
                         URI      : String) return Module_Access;

   --  Iterate over the modules that have been registered and execute the Process
   --  procedure on each of the module instance.
   procedure Iterate (Registry : in Module_Registry;
                      Process  : access procedure (Plugin : in out Module'Class));

private

   use Ada.Strings.Unbounded;

   type Module is abstract new Ada.Finalization.Limited_Controlled with record
      Registry   : Module_Registry_Access;
      App        : Application_Access := null;
      Name       : Unbounded_String;
      URI        : Unbounded_String;
      Config     : ASF.Applications.Config;
      Self       : Module_Access := null;
      Listeners  : Util.Listeners.List;
   end record;

   --  Map to find a module from its name or its URI
   package Module_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                            Element_Type    => Module_Access,
                                            Hash            => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   type Module_Registry is limited record
      Config   : ASF.Applications.Config;
      Name_Map : Module_Maps.Map;
      URI_Map  : Module_Maps.Map;
   end record;

   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with record
      Module : Module_Access := null;
   end record;

   type Pool_Module is new Module with record
      D : Natural;
   end record;

   type Session_Module is new Module with record
      P : Natural;
   end record;

   use Util.Log;

   --  The logger (used by the generic Get function).
   Log : constant Loggers.Logger := Loggers.Create ("AWA.Modules");

end AWA.Modules;

Declare a Get_Config function on the module to retrieve a boolean configuration parameter


-----------------------------------------------------------------------
--  Util-strings -- Various String Utility
--  Copyright (C) 2001, 2002, 2003, 2009, 2010, 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings;
with Ada.Strings.Unbounded;
with Ada.Containers;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Hashed_Sets;
with Util.Concurrent.Counters;
package Util.Strings is

   pragma Preelaborate;

   --  Constant string access
   type Name_Access is access constant String;

   --  Compute the hash value of the string.
   function Hash (Key : Name_Access) return Ada.Containers.Hash_Type;

   --  Returns true if left and right strings are equivalent.
   function Equivalent_Keys (Left, Right : Name_Access) return Boolean;

   --  Search for the first occurrence of the character in the string
   --  after the from index.  This implementation is 3-times faster than
   --  the Ada.Strings.Fixed version.
   --  Returns the index of the first occurrence or 0.
   function Index (Source : in String;
                   Char   : in Character;
                   From   : in Natural := 0) return Natural;

   --  Search for the first occurrence of the character in the string
   --  before the from index and going backward.
   --  This implementation is 3-times faster than the Ada.Strings.Fixed version.
   --  Returns the index of the first occurrence or 0.
   function Rindex (Source : in String;
                    Ch     : in Character;
                    From   : in Natural := 0) return Natural;

   --  Search for the first occurrence of the pattern in the string.
   function Index (Source  : in String;
                   Pattern : in String;
                   From    : in Positive;
                   Going   : in Ada.Strings.Direction := Ada.Strings.Forward) return Natural;

   --  Returns Integer'Image (Value) with the possible space stripped.
   function Image (Value : in Integer) return String;

   --  Returns Integer'Image (Value) with the possible space stripped.
   function Image (Value : in Long_Long_Integer) return String;

   package String_Access_Map is new Ada.Containers.Hashed_Maps
     (Key_Type        => Name_Access,
      Element_Type    => Name_Access,
      Hash            => Hash,
      Equivalent_Keys => Equivalent_Keys);

   package String_Set is new Ada.Containers.Hashed_Sets
     (Element_Type    => Name_Access,
      Hash            => Hash,
      Equivalent_Elements => Equivalent_Keys);

   --  String reference
   type String_Ref is private;

   --  Create a string reference from a string.
   function To_String_Ref (S : in String) return String_Ref;

   --  Create a string reference from an unbounded string.
   function To_String_Ref (S : in Ada.Strings.Unbounded.Unbounded_String) return String_Ref;

   --  Get the string
   function To_String (S : in String_Ref) return String;

   --  Get the string as an unbounded string
   function To_Unbounded_String (S : in String_Ref) return Ada.Strings.Unbounded.Unbounded_String;

   --  Compute the hash value of the string reference.
   function Hash (Key : in String_Ref) return Ada.Containers.Hash_Type;

   --  Returns true if left and right string references are equivalent.
   function Equivalent_Keys (Left, Right : in String_Ref) return Boolean;
   function "=" (Left, Right : in String_Ref) return Boolean renames Equivalent_Keys;
   function "=" (Left  : in String_Ref;
                 Right : in String) return Boolean;
   function "=" (Left  : in String_Ref;
                 Right : in Ada.Strings.Unbounded.Unbounded_String) return Boolean;

   --  Returns the string length.
   function Length (S : in String_Ref) return Natural;

private
   pragma Inline (To_String_Ref);
   pragma Inline (To_String);

   type String_Record (Len : Natural) is limited record
      Counter : Util.Concurrent.Counters.Counter;
      Str     : String (1 .. Len);
   end record;
   type String_Record_Access is access all String_Record;

   type String_Ref is new Ada.Finalization.Controlled with record
      Str : String_Record_Access := null;
   end record;

   pragma Finalize_Storage_Only (String_Ref);

   --  Increment the reference counter.
   overriding
   procedure Adjust (Object : in out String_Ref);

   --  Decrement the reference counter and free the allocated string.
   overriding
   procedure Finalize (Object : in out String_Ref);

end Util.Strings;

-----------------------------------------------------------------------
--  util-strings -- Various String Utility
--  Copyright (C) 2001, 2002, 2003, 2009, 2010, 2011, 2012, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings;
with Ada.Strings.Unbounded;
with Ada.Containers;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Hashed_Sets;
private with Util.Concurrent.Counters;
package Util.Strings is

   pragma Preelaborate;

   --  Constant string access
   type Name_Access is access constant String;

   --  Compute the hash value of the string.
   function Hash (Key : Name_Access) return Ada.Containers.Hash_Type;

   --  Returns true if left and right strings are equivalent.
   function Equivalent_Keys (Left, Right : Name_Access) return Boolean;

   --  Search for the first occurrence of the character in the string
   --  after the from index.  This implementation is 3-times faster than
   --  the Ada.Strings.Fixed version.
   --  Returns the index of the first occurrence or 0.
   function Index (Source : in String;
                   Char   : in Character;
                   From   : in Natural := 0) return Natural;

   --  Search for the first occurrence of the character in the string
   --  before the from index and going backward.
   --  This implementation is 3-times faster than the Ada.Strings.Fixed version.
   --  Returns the index of the first occurrence or 0.
   function Rindex (Source : in String;
                    Ch     : in Character;
                    From   : in Natural := 0) return Natural;

   --  Search for the first occurrence of the pattern in the string.
   function Index (Source  : in String;
                   Pattern : in String;
                   From    : in Positive;
                   Going   : in Ada.Strings.Direction := Ada.Strings.Forward) return Natural;

   --  Returns Integer'Image (Value) with the possible space stripped.
   function Image (Value : in Integer) return String;

   --  Returns Integer'Image (Value) with the possible space stripped.
   function Image (Value : in Long_Long_Integer) return String;

   package String_Access_Map is new Ada.Containers.Hashed_Maps
     (Key_Type        => Name_Access,
      Element_Type    => Name_Access,
      Hash            => Hash,
      Equivalent_Keys => Equivalent_Keys);

   package String_Set is new Ada.Containers.Hashed_Sets
     (Element_Type    => Name_Access,
      Hash            => Hash,
      Equivalent_Elements => Equivalent_Keys);

   --  String reference
   type String_Ref is private;

   --  Create a string reference from a string.
   function To_String_Ref (S : in String) return String_Ref;

   --  Create a string reference from an unbounded string.
   function To_String_Ref (S : in Ada.Strings.Unbounded.Unbounded_String) return String_Ref;

   --  Get the string
   function To_String (S : in String_Ref) return String;

   --  Get the string as an unbounded string
   function To_Unbounded_String (S : in String_Ref) return Ada.Strings.Unbounded.Unbounded_String;

   --  Compute the hash value of the string reference.
   function Hash (Key : in String_Ref) return Ada.Containers.Hash_Type;

   --  Returns true if left and right string references are equivalent.
   function Equivalent_Keys (Left, Right : in String_Ref) return Boolean;
   function "=" (Left, Right : in String_Ref) return Boolean renames Equivalent_Keys;
   function "=" (Left  : in String_Ref;
                 Right : in String) return Boolean;
   function "=" (Left  : in String_Ref;
                 Right : in Ada.Strings.Unbounded.Unbounded_String) return Boolean;

   --  Returns the string length.
   function Length (S : in String_Ref) return Natural;

private
   pragma Inline (To_String_Ref);
   pragma Inline (To_String);

   type String_Record (Len : Natural) is limited record
      Counter : Util.Concurrent.Counters.Counter;
      Str     : String (1 .. Len);
   end record;
   type String_Record_Access is access all String_Record;

   type String_Ref is new Ada.Finalization.Controlled with record
      Str : String_Record_Access := null;
   end record;

   --  Increment the reference counter.
   overriding
   procedure Adjust (Object : in out String_Ref);

   --  Decrement the reference counter and free the allocated string.
   overriding
   procedure Finalize (Object : in out String_Ref);

end Util.Strings;

Change with clause to a private with clause for concurrent counters


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

with Wiki.Attributes;
with Wiki.Documents;
with Wiki.Nodes;
with Wiki.Strings;

--  == Filters ==
--  The <b>Wiki.Filters</b> package provides a simple filter framework that allows to plug
--  specific filters when a wiki document is parsed and processed.  The <tt>Filter_Type</tt>
--  implements the <tt>Document_Reader</tt> interface to catch all the wiki document operations
--  and it forwards the different calls to a next wiki document instance.  A filter can do some
--  operations while calls are made so that it can:
--
--  * Get the text content and filter it by looking at forbidden words in some dictionary,
--  * Ignore some formatting construct (for example to forbid the use of links),
--  * Verify and do some corrections on HTML content embedded in wiki text,
--  * Expand some plugins, specific links to complex content.
--
--  To implement a new filter, the <tt>Filter_Type</tt> type must be used as a base type
--  and some of the operations have to be overriden.  The default <tt>Filter_Type</tt> operations
--  just propagate the call to the attached wiki document instance (ie, a kind of pass
--  through filter).
--
package Wiki.Filters is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   --  ------------------------------
   --  Filter type
   --  ------------------------------
   type Filter_Type is new Ada.Finalization.Limited_Controlled with private;
   type Filter_Type_Access is access all Filter_Type'Class;

   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   procedure Add_Node (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind);

   --  Add a text content with the given format to the document.
   procedure Add_Text (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Nodes.Format_Map);

   --  Add a section header with the given level in the document.
   procedure Add_Header (Filter    : in out Filter_Type;
                         Document  : in out Wiki.Nodes.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural);

   --  Push a HTML node with the given tag to the document.
   procedure Push_Node (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Tag        : in Wiki.Nodes.Html_Tag_Type;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type);

   --  Pop a HTML node with the given tag.
   procedure Pop_Node (Filter   : in out Filter_Type;
                       Document : in out Wiki.Nodes.Document;
                       Tag      : in Wiki.Nodes.Html_Tag_Type);

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Filter   : in out Filter_Type;
                             Document : in out Wiki.Nodes.Document;
                             Level    : in Natural);

   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Filter   : in out Filter_Type;
                            Document : in out Wiki.Nodes.Document;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Add a link.
   procedure Add_Link (Filter     : in out Filter_Type;
                       Document   : in out Wiki.Nodes.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List_Type);

   --  Add an image.
   procedure Add_Image (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type);

   --  Add a quote.
   procedure Add_Quote (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Filter   : in out Filter_Type;
                               Document : in out Wiki.Nodes.Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Unbounded_Wide_Wide_String);

   --  Finish the document after complete wiki text has been parsed.
   procedure Finish (Filter : in out Filter_Type);

private

   type Filter_Type is new Ada.Finalization.Limited_Controlled with record
      Next     : Filter_Type_Access;
   end record;

end Wiki.Filters;

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

with Wiki.Attributes;
with Wiki.Documents;
with Wiki.Nodes;
with Wiki.Strings;

--  == Filters ==
--  The <b>Wiki.Filters</b> package provides a simple filter framework that allows to plug
--  specific filters when a wiki document is parsed and processed.  The <tt>Filter_Type</tt>
--  implements the <tt>Document_Reader</tt> interface to catch all the wiki document operations
--  and it forwards the different calls to a next wiki document instance.  A filter can do some
--  operations while calls are made so that it can:
--
--  * Get the text content and filter it by looking at forbidden words in some dictionary,
--  * Ignore some formatting construct (for example to forbid the use of links),
--  * Verify and do some corrections on HTML content embedded in wiki text,
--  * Expand some plugins, specific links to complex content.
--
--  To implement a new filter, the <tt>Filter_Type</tt> type must be used as a base type
--  and some of the operations have to be overriden.  The default <tt>Filter_Type</tt> operations
--  just propagate the call to the attached wiki document instance (ie, a kind of pass
--  through filter).
--
package Wiki.Filters is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   --  ------------------------------
   --  Filter type
   --  ------------------------------
   type Filter_Type is new Ada.Finalization.Limited_Controlled with private;
   type Filter_Type_Access is access all Filter_Type'Class;

   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   procedure Add_Node (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind);

   --  Add a text content with the given format to the document.
   procedure Add_Text (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Nodes.Format_Map);

   --  Add a section header with the given level in the document.
   procedure Add_Header (Filter    : in out Filter_Type;
                         Document  : in out Wiki.Nodes.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural);

   --  Push a HTML node with the given tag to the document.
   procedure Push_Node (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Tag        : in Wiki.Nodes.Html_Tag_Type;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type);

   --  Pop a HTML node with the given tag.
   procedure Pop_Node (Filter   : in out Filter_Type;
                       Document : in out Wiki.Nodes.Document;
                       Tag      : in Wiki.Nodes.Html_Tag_Type);

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Filter   : in out Filter_Type;
                             Document : in out Wiki.Nodes.Document;
                             Level    : in Natural);

   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Filter   : in out Filter_Type;
                            Document : in out Wiki.Nodes.Document;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Add a link.
   procedure Add_Link (Filter     : in out Filter_Type;
                       Document   : in out Wiki.Nodes.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List_Type);

   --  Add an image.
   procedure Add_Image (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type);

   --  Add a quote.
   procedure Add_Quote (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Filter   : in out Filter_Type;
                               Document : in out Wiki.Nodes.Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Unbounded_Wide_Wide_String);

   --  Finish the document after complete wiki text has been parsed.
   procedure Finish (Filter   : in out Filter_Type;
                     Document : in out Wiki.Nodes.Document);

private

   type Filter_Type is new Ada.Finalization.Limited_Controlled with record
      Next     : Filter_Type_Access;
   end record;

end Wiki.Filters;

Add a Document parameter to the Finish procedure


-----------------------------------------------------------------------
--  wiki-helpers-parser -- Generic procedure for the wiki parser
--  Copyright (C) 2016, 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 Wiki.Helpers;
with Wiki.Streams;
procedure Wiki.Helpers.Parser (Engine  : in out Engine_Type;
                               Content : in Element_Type;
                               Doc     : in out Wiki.Documents.Document) is

   type Wide_Input is new Wiki.Streams.Input_Stream with record
      Pos : Positive;
      Len : Natural;
   end record;

   overriding
   procedure Read (Buf    : in out Wide_Input;
                   Token  : out Wiki.Strings.WChar;
                   Is_Eof : out Boolean);

   procedure Read (Buf    : in out Wide_Input;
                   Token  : out Wiki.Strings.WChar;
                   Is_Eof : out Boolean) is
   begin
      if Buf.Pos <= Buf.Len then
         Element (Content, Buf.Pos, Token);
         Is_Eof := False;
      else
         Is_Eof := True;
         Token := Wiki.Helpers.CR;
      end if;
   end Read;

   Buffer : aliased Wide_Input;
begin
   Buffer.Pos   := 1;
   Buffer.Len   := Length (Content);
   Parse (Engine, Buffer'Unchecked_Access, Doc);
end Wiki.Helpers.Parser;

-----------------------------------------------------------------------
--  wiki-helpers-parser -- Generic procedure for the wiki parser
--  Copyright (C) 2016, 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 Wiki.Helpers;
with Wiki.Streams;
procedure Wiki.Helpers.Parser (Engine  : in out Engine_Type;
                               Content : in Element_Type;
                               Doc     : in out Wiki.Documents.Document) is

   type Wide_Input is new Wiki.Streams.Input_Stream with record
      Pos : Positive;
      Len : Natural;
   end record;

   --  Read the input stream and fill the `Into` buffer until either it is full or
   --  we reach the end of line.  Returns in `Last` the last valid position in the
   --  `Into` buffer.  When there is no character to read, return True in
   --  the `Eof` indicator.
   overriding
   procedure Read (Input : in out Wide_Input;
                   Into  : in out Wiki.Strings.WString;
                   Last  : out Natural;
                   Eof   : out Boolean);

   overriding
   procedure Read (Input : in out Wide_Input;
                   Into  : in out Wiki.Strings.WString;
                   Last  : out Natural;
                   Eof   : out Boolean) is
      Pos  : Natural := Into'First;
      Char : Wiki.Strings.WChar;
   begin
      Eof := False;
      while Pos <= Into'Last loop
         if Input.Pos <= Input.Len then
            Element (Content, Input.Pos, Char);
         else
            Eof := True;
            exit;
         end if;
         Into (Pos) := Char;
         Pos := Pos + 1;
         exit when Char = Helpers.CR or Char = Helpers.LF;
      end loop;
      Last := Pos - 1;
   end Read;

   Buffer : aliased Wide_Input;
begin
   Buffer.Pos   := 1;
   Buffer.Len   := Length (Content);
   Parse (Engine, Buffer'Unchecked_Access, Doc);
end Wiki.Helpers.Parser;

Update the Read procedure to read a complete line


-----------------------------------------------------------------------
--  Util.Beans.Objects.Enums -- Helper conversion for discrete types
--  Copyright (C) 2010, 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Characters.Conversions;
package body Util.Beans.Objects.Enums is

   use Ada.Characters.Conversions;

   Value_Range : constant Long_Long_Integer := T'Pos (T'Last) - T'Pos (T'First) + 1;

   --  ------------------------------
   --  Integer Type
   --  ------------------------------
   type Enum_Type is new Int_Type with null record;

   --  Get the type name
   overriding
   function Get_Name (Type_Def : in Enum_Type) return String;

   overriding
   function To_String (Type_Def : in Enum_Type;
                       Value    : in Object_Value) return String;

   --  ------------------------------
   --  Get the type name
   --  ------------------------------
   overriding
   function Get_Name (Type_Def : Enum_Type) return String is
      pragma Unreferenced (Type_Def);
   begin
      return "Enum";
   end Get_Name;

   --  ------------------------------
   --  Convert the value into a string.
   --  ------------------------------
   overriding
   function To_String (Type_Def : in Enum_Type;
                       Value    : in Object_Value) return String is
      pragma Unreferenced (Type_Def);
   begin
      return T'Image (T'Val (Value.Int_Value));
   end To_String;

   Value_Type  : aliased constant Enum_Type := Enum_Type '(null record);

   --  ------------------------------
   --  Create an object from the given value.
   --  ------------------------------
   function To_Object (Value : in T) return Object is
   begin
      return Object '(Controlled with
        V => Object_Value '(Of_Type   => TYPE_INTEGER,
                            Int_Value => Long_Long_Integer (T'Pos (Value))),
        Type_Def  => Value_Type'Access);
   end To_Object;

   --  ------------------------------
   --  Convert the object into a value.
   --  Raises Constraint_Error if the object cannot be converter to the target type.
   --  ------------------------------
   function To_Value (Value : in Util.Beans.Objects.Object) return T is
   begin
      case Value.V.Of_Type is
         when TYPE_INTEGER =>
            if ROUND_VALUE then
               return T'Val (Value.V.Int_Value mod Value_Range);
            else
               return T'Val (Value.V.Int_Value);
            end if;

         when TYPE_BOOLEAN =>
            return T'Val (Boolean'Pos (Value.V.Bool_Value));

         when TYPE_FLOAT =>
            if ROUND_VALUE then
               return T'Val (To_Long_Long_Integer (Value) mod Value_Range);
            else
               return T'Val (To_Long_Long_Integer (Value));
            end if;

         when TYPE_STRING =>
            if Value.V.String_Proxy = null then
               raise Constraint_Error with "The object value is null";
            end if;
            return T'Value (Value.V.String_Proxy.Value);

         when TYPE_WIDE_STRING =>
            if Value.V.Wide_Proxy = null then
               raise Constraint_Error with "The object value is null";
            end if;
            return T'Value (To_String (Value.V.Wide_Proxy.Value));

         when TYPE_NULL =>
            raise Constraint_Error with "The object value is null";

         when TYPE_TIME =>
            raise Constraint_Error with "Cannot convert a date into a discrete type";

         when TYPE_BEAN =>
            raise Constraint_Error with "Cannot convert a bean into a discrete type";

         when TYPE_ARRAY =>
            raise Constraint_Error with "Cannot convert an array into a discrete type";

      end case;
   end To_Value;

end Util.Beans.Objects.Enums;

-----------------------------------------------------------------------
--  util-beans-objects-enums -- Helper conversion for discrete types
--  Copyright (C) 2010, 2016, 2017, 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.Characters.Conversions;
package body Util.Beans.Objects.Enums is

   use Ada.Characters.Conversions;

   Value_Range : constant Long_Long_Integer := T'Pos (T'Last) - T'Pos (T'First) + 1;

   --  ------------------------------
   --  Integer Type
   --  ------------------------------
   type Enum_Type is new Int_Type with null record;

   --  Get the type name
   overriding
   function Get_Name (Type_Def : in Enum_Type) return String;

   overriding
   function To_String (Type_Def : in Enum_Type;
                       Value    : in Object_Value) return String;

   --  ------------------------------
   --  Get the type name
   --  ------------------------------
   overriding
   function Get_Name (Type_Def : Enum_Type) return String is
      pragma Unreferenced (Type_Def);
   begin
      return "Enum";
   end Get_Name;

   --  ------------------------------
   --  Convert the value into a string.
   --  ------------------------------
   overriding
   function To_String (Type_Def : in Enum_Type;
                       Value    : in Object_Value) return String is
      pragma Unreferenced (Type_Def);
   begin
      return T'Image (T'Val (Value.Int_Value));
   end To_String;

   Value_Type  : aliased constant Enum_Type := Enum_Type '(null record);

   --  ------------------------------
   --  Create an object from the given value.
   --  ------------------------------
   function To_Object (Value : in T) return Object is
   begin
      return Object '(Controlled with
        V => Object_Value '(Of_Type   => TYPE_INTEGER,
                            Int_Value => Long_Long_Integer (T'Pos (Value))),
        Type_Def  => Value_Type'Access);
   end To_Object;

   --  ------------------------------
   --  Convert the object into a value.
   --  Raises Constraint_Error if the object cannot be converter to the target type.
   --  ------------------------------
   function To_Value (Value : in Util.Beans.Objects.Object) return T is
   begin
      case Value.V.Of_Type is
         when TYPE_INTEGER =>
            if ROUND_VALUE then
               return T'Val (Value.V.Int_Value mod Value_Range);
            else
               return T'Val (Value.V.Int_Value);
            end if;

         when TYPE_BOOLEAN =>
            return T'Val (Boolean'Pos (Value.V.Bool_Value));

         when TYPE_FLOAT =>
            if ROUND_VALUE then
               return T'Val (To_Long_Long_Integer (Value) mod Value_Range);
            else
               return T'Val (To_Long_Long_Integer (Value));
            end if;

         when TYPE_STRING =>
            if Value.V.String_Proxy = null then
               raise Constraint_Error with "The object value is null";
            end if;
            return T'Value (Value.V.String_Proxy.Value);

         when TYPE_WIDE_STRING =>
            if Value.V.Wide_Proxy = null then
               raise Constraint_Error with "The object value is null";
            end if;
            return T'Value (To_String (Value.V.Wide_Proxy.Value));

         when TYPE_NULL =>
            raise Constraint_Error with "The object value is null";

         when TYPE_TIME =>
            raise Constraint_Error with "Cannot convert a date into a discrete type";

         when TYPE_RECORD =>
            raise Constraint_Error with "Cannot convert a record into a discrete type";

         when TYPE_BEAN =>
            raise Constraint_Error with "Cannot convert a bean into a discrete type";

         when TYPE_ARRAY =>
            raise Constraint_Error with "Cannot convert an array into a discrete type";

      end case;
   end To_Value;

end Util.Beans.Objects.Enums;

Handle the TYPE_RECORD

Handle the TYPE_RECORD


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

with ASF.Events.Phases;
with ASF.Components.Base;
with ASF.Events.Faces.Actions;
with ASF.Applications.Main;

package body ASF.Components.Core.Views is

   use ASF;
   use EL.Objects;
   use type Base.UIComponent_Access;

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => ASF.Events.Faces.Faces_Event'Class,
                                     Name   => Faces_Event_Access);

   --  ------------------------------
   --  Get the content type returned by the view.
   --  ------------------------------
   function Get_Content_Type (UI      : in UIView;
                              Context : in Faces_Context'Class) return String is
   begin
      if Util.Beans.Objects.Is_Null (UI.Content_Type) then
         return UI.Get_Attribute (Name => "contentType", Context => Context);
      else
         return Util.Beans.Objects.To_String (UI.Content_Type);
      end if;
   end Get_Content_Type;

   --  ------------------------------
   --  Set the content type returned by the view.
   --  ------------------------------
   procedure Set_Content_Type (UI     : in out UIView;
                               Value  : in String) is
   begin
      UI.Content_Type := Util.Beans.Objects.To_Object (Value);
   end Set_Content_Type;

   --  ------------------------------
   --  Get the locale to be used when rendering messages in the view.
   --  If a locale was set explicitly, return it.
   --  If the view component defines a locale attribute, evaluate and return its value.
   --  If the locale is empty, calculate the locale by using the request context and the view
   --  handler.
   --  ------------------------------
   function Get_Locale (UI      : in UIView;
                        Context : in Faces_Context'Class) return Util.Locales.Locale is
      use type Util.Locales.Locale;
   begin
      if UI.Locale /= Util.Locales.NULL_LOCALE then
         return UI.Locale;
      end if;
      declare
         Value : constant Util.Beans.Objects.Object := UI.Get_Attribute (Name    => "locale",
                                                                         Context => Context);
      begin
         --  If the root view does not specify any locale, calculate it from the request.
         if Util.Beans.Objects.Is_Null (Value) then
            return Context.Get_Application.Get_View_Handler.Calculate_Locale (Context);
         end if;

         --  Resolve the locale.  If it is not valid, calculate it from the request.
         declare
            Name   : constant String := Util.Beans.Objects.To_String (Value);
            Locale : constant Util.Locales.Locale := Util.Locales.Get_Locale (Name);
         begin
            if Locale /= Util.Locales.NULL_LOCALE then
               return Locale;
            else
               return Context.Get_Application.Get_View_Handler.Calculate_Locale (Context);
            end if;
         end;
      end;
   end Get_Locale;

   --  ------------------------------
   --  Set the locale to be used when rendering messages in the view.
   --  ------------------------------
   procedure Set_Locale (UI     : in out UIView;
                         Locale : in Util.Locales.Locale) is
   begin
      UI.Locale := Locale;
   end Set_Locale;

   --  ------------------------------
   --  Encode the begining of the view.  Set the response content type.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIView;
                           Context : in out Faces_Context'Class) is
      Content_Type : constant String := UI.Get_Content_Type (Context => Context);
   begin
      Context.Get_Response.Set_Content_Type (Content_Type);
      if UI.Left_Tree /= null then
         UI.Left_Tree.Encode_All (Context);
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Encode the end of the view.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIView;
                         Context : in out Faces_Context'Class) is
   begin
      if UI.Right_Tree /= null then
         UI.Right_Tree.Encode_All (Context);
      end if;
   end Encode_End;

   --  ------------------------------
   --  Decode any new state of the specified component from the request contained
   --  in the specified context and store that state on the component.
   --
   --  During decoding, events may be enqueued for later processing
   --  (by event listeners that have registered an interest), by calling
   --  the Queue_Event on the associated component.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Decodes (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.APPLY_REQUEST_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Decodes;

   --  ------------------------------
   --  Perform the component tree processing required by the Process Validations
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows:
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Validators of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Validators (UI      : in out UIView;
                                 Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Validators (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.PROCESS_VALIDATION, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Validators;

   --  ------------------------------
   --  Perform the component tree processing required by the Update Model Values
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows.
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Updates/b> of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Updates (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Updates (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.UPDATE_MODEL_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Updates;

   --  ------------------------------
   --  Broadcast any events that have been queued for the Invoke Application
   --  phase of the request processing lifecycle and to clear out any events
   --  for later phases if the event processing for this phase caused
   --  renderResponse or responseComplete to be called.
   --  ------------------------------
   procedure Process_Application (UI      : in out UIView;
                                  Context : in out Faces_Context'Class) is
   begin
      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.INVOKE_APPLICATION, Context);
   end Process_Application;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   procedure Queue_Event (UI    : in out UIView;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         Parent.Queue_Event (Event);
      else
         UI.Phase_Events (Event.Get_Phase).Append (Event.all'Access);
      end if;
   end Queue_Event;

   --  ------------------------------
   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   --  ------------------------------
   procedure Broadcast (UI      : in out UIView;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is

      Pos : Natural := 0;

      --  Broadcast the event to the component's listeners
      --  and free that event.
      procedure Broadcast (Ev : in out Faces_Event_Access);

      procedure Broadcast (Ev : in out Faces_Event_Access) is
      begin
         if Ev /= null then
            declare
               C  : constant Base.UIComponent_Access := Ev.Get_Component;
            begin
               C.Broadcast (Ev, Context);
            end;
            Free (Ev);
         end if;
      end Broadcast;

      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         UIView'Class (Parent.all).Broadcast (Phase, Context);
      else
         --  Dispatch events in the order in which they were queued.
         --  More events could be queued as a result of the dispatch.
         --  After dispatching an event, it is freed but not removed
         --  from the event queue (the access will be cleared).
         loop
            exit when Pos > UI.Phase_Events (Phase).Last_Index;
            UI.Phase_Events (Phase).Update_Element (Pos, Broadcast'Access);
            Pos := Pos + 1;
         end loop;

         --  Now, clear the queue.
         UI.Phase_Events (Phase).Clear;
      end if;
   end Broadcast;

   --  ------------------------------
   --  Clear the events that were queued.
   --  ------------------------------
   procedure Clear_Events (UI : in out UIView) is
   begin
      for Phase in UI.Phase_Events'Range loop
         for I in 0 .. UI.Phase_Events (Phase).Last_Index loop
            declare
               Ev : Faces_Event_Access := UI.Phase_Events (Phase).Element (I);
            begin
               Free (Ev);
            end;
         end loop;
         UI.Phase_Events (Phase).Clear;
      end loop;
   end Clear_Events;

   --  ------------------------------
   --  Set the component tree that must be rendered before this view.
   --  This is an internal method used by Steal_Root_Component exclusively.
   --  ------------------------------
   procedure Set_Before_View (UI   : in out UIView'Class;
                              Tree : in Base.UIComponent_Access) is
   begin
      if UI.Left_Tree /= null then
         UI.Log_Error ("Set_Before_View called while there is a tree");
      end if;
      UI.Left_Tree := Tree;
   end Set_Before_View;

   --  ------------------------------
   --  Set the component tree that must be rendered after this view.
   --  This is an internal method used by Steal_Root_Component exclusively.
   --  ------------------------------
   procedure Set_After_View (UI   : in out UIView'Class;
                             Tree : in Base.UIComponent_Access) is
   begin
      if UI.Right_Tree /= null then
         UI.Log_Error ("Set_Before_View called while there is a tree");
      end if;
      UI.Right_Tree := Tree;
   end Set_After_View;

   --  ------------------------------
   --  Finalize the object.
   --  ------------------------------
   overriding
   procedure Finalize (UI : in out UIView) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Base.UIComponent'Class,
                                        Name   => Base.UIComponent_Access);

   begin
      Free (UI.Left_Tree);
      Free (UI.Right_Tree);
      Base.UIComponent (UI).Finalize;
   end Finalize;

   --  ------------------------------
   --  Set the metadata facet on the UIView component.
   --  ------------------------------
   procedure Set_Metadata (UI    : in out UIView;
                           Meta  : in UIViewMetaData_Access;
                           Tag   : access ASF.Views.Nodes.Tag_Node'Class) is
   begin
      if UI.Meta /= null then
         UI.Log_Error ("A <f:metadata> component was already registered.");
--           Delete (UI.Meta);
      end if;
      Meta.Root := UI'Unchecked_Access;
      UI.Meta := Meta;
      UI.Add_Facet (METADATA_FACET_NAME, Meta.all'Access, Tag);
   end Set_Metadata;

   --  ------------------------------
   --  Get the input parameter from the submitted context.  This operation is called by
   --  <tt>Process_Decodes</tt> to retrieve the request parameter associated with the component.
   --  ------------------------------
   overriding
   function Get_Parameter (UI      : in UIViewParameter;
                           Context : in Faces_Context'Class) return String is
      Name : constant String := UI.Get_Attribute ("name", Context);
   begin
      if Name'Length > 0 then
         return Context.Get_Parameter (Name);
      else
         return Html.Forms.UIInput (UI).Get_Parameter (Context);
      end if;
   end Get_Parameter;

   --  ------------------------------
   --  Decode the request and prepare for the execution for the view action.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIViewAction;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      begin
         ASF.Events.Faces.Actions.Post_Event (UI     => UI,
                                              Method => UI.Get_Action_Expression (Context));

      exception
         when EL.Expressions.Invalid_Expression =>
            null;
      end;
   end Process_Decodes;

   --  ------------------------------
   --  Get the root component.
   --  ------------------------------
   function Get_Root (UI      : in UIViewMetaData) return Base.UIComponent_Access is
      Result : Base.UIComponent_Access := UI.Get_Parent;
      Parent : Base.UIComponent_Access := Result.Get_Parent;
   begin
      while Parent /= null loop
         Result := Parent;
         Parent := Parent.Get_Parent;
      end loop;
      return Result;
   end Get_Root;

   --  ------------------------------
   --  Start encoding the UIComponent.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIViewMetaData;
                           Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_Begin (Context);
   end Encode_Begin;

   --  ------------------------------
   --  Encode the children of this component.
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIViewMetaData;
                              Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_Children (Context);
   end Encode_Children;

   --  ------------------------------
   --  Finish encoding the component.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIViewMetaData;
                         Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_End (Context);
   end Encode_End;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   overriding
   procedure Queue_Event (UI    : in out UIViewMetaData;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
   begin
      UI.Root.Queue_Event (Event);
   end Queue_Event;

   --  ------------------------------
   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   --  ------------------------------
   overriding
   procedure Broadcast (UI      : in out UIViewMetaData;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is
   begin
      UI.Root.Broadcast (Phase, Context);
   end Broadcast;

   --  ------------------------------
   --  Clear the events that were queued.
   --  ------------------------------
   overriding
   procedure Clear_Events (UI : in out UIViewMetaData) is
   begin
      UI.Root.Clear_Events;
   end Clear_Events;

end ASF.Components.Core.Views;

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

with ASF.Events.Phases;
with ASF.Components.Base;
with ASF.Events.Faces.Actions;
with ASF.Applications.Main;

package body ASF.Components.Core.Views is

   use EL.Objects;
   use type Base.UIComponent_Access;

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => ASF.Events.Faces.Faces_Event'Class,
                                     Name   => Faces_Event_Access);

   --  ------------------------------
   --  Get the content type returned by the view.
   --  ------------------------------
   function Get_Content_Type (UI      : in UIView;
                              Context : in Faces_Context'Class) return String is
   begin
      if Util.Beans.Objects.Is_Null (UI.Content_Type) then
         return UI.Get_Attribute (Name => "contentType", Context => Context);
      else
         return Util.Beans.Objects.To_String (UI.Content_Type);
      end if;
   end Get_Content_Type;

   --  ------------------------------
   --  Set the content type returned by the view.
   --  ------------------------------
   procedure Set_Content_Type (UI     : in out UIView;
                               Value  : in String) is
   begin
      UI.Content_Type := Util.Beans.Objects.To_Object (Value);
   end Set_Content_Type;

   --  ------------------------------
   --  Get the locale to be used when rendering messages in the view.
   --  If a locale was set explicitly, return it.
   --  If the view component defines a locale attribute, evaluate and return its value.
   --  If the locale is empty, calculate the locale by using the request context and the view
   --  handler.
   --  ------------------------------
   function Get_Locale (UI      : in UIView;
                        Context : in Faces_Context'Class) return Util.Locales.Locale is
      use type Util.Locales.Locale;
   begin
      if UI.Locale /= Util.Locales.NULL_LOCALE then
         return UI.Locale;
      end if;
      declare
         Value : constant Util.Beans.Objects.Object := UI.Get_Attribute (Name    => "locale",
                                                                         Context => Context);
      begin
         --  If the root view does not specify any locale, calculate it from the request.
         if Util.Beans.Objects.Is_Null (Value) then
            return Context.Get_Application.Get_View_Handler.Calculate_Locale (Context);
         end if;

         --  Resolve the locale.  If it is not valid, calculate it from the request.
         declare
            Name   : constant String := Util.Beans.Objects.To_String (Value);
            Locale : constant Util.Locales.Locale := Util.Locales.Get_Locale (Name);
         begin
            if Locale /= Util.Locales.NULL_LOCALE then
               return Locale;
            else
               return Context.Get_Application.Get_View_Handler.Calculate_Locale (Context);
            end if;
         end;
      end;
   end Get_Locale;

   --  ------------------------------
   --  Set the locale to be used when rendering messages in the view.
   --  ------------------------------
   procedure Set_Locale (UI     : in out UIView;
                         Locale : in Util.Locales.Locale) is
   begin
      UI.Locale := Locale;
   end Set_Locale;

   --  ------------------------------
   --  Encode the begining of the view.  Set the response content type.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIView;
                           Context : in out Faces_Context'Class) is
      Content_Type : constant String := UI.Get_Content_Type (Context => Context);
   begin
      Context.Get_Response.Set_Content_Type (Content_Type);
      if UI.Left_Tree /= null then
         UI.Left_Tree.Encode_All (Context);
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Encode the end of the view.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIView;
                         Context : in out Faces_Context'Class) is
   begin
      if UI.Right_Tree /= null then
         UI.Right_Tree.Encode_All (Context);
      end if;
   end Encode_End;

   --  ------------------------------
   --  Decode any new state of the specified component from the request contained
   --  in the specified context and store that state on the component.
   --
   --  During decoding, events may be enqueued for later processing
   --  (by event listeners that have registered an interest), by calling
   --  the Queue_Event on the associated component.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Decodes (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.APPLY_REQUEST_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Decodes;

   --  ------------------------------
   --  Perform the component tree processing required by the Process Validations
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows:
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Validators of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Validators (UI      : in out UIView;
                                 Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Validators (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.PROCESS_VALIDATION, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Validators;

   --  ------------------------------
   --  Perform the component tree processing required by the Update Model Values
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows.
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Updates/b> of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Updates (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Updates (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.UPDATE_MODEL_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Updates;

   --  ------------------------------
   --  Broadcast any events that have been queued for the Invoke Application
   --  phase of the request processing lifecycle and to clear out any events
   --  for later phases if the event processing for this phase caused
   --  renderResponse or responseComplete to be called.
   --  ------------------------------
   procedure Process_Application (UI      : in out UIView;
                                  Context : in out Faces_Context'Class) is
   begin
      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.INVOKE_APPLICATION, Context);
   end Process_Application;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   procedure Queue_Event (UI    : in out UIView;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         Parent.Queue_Event (Event);
      else
         UI.Phase_Events (Event.Get_Phase).Append (Event.all'Access);
      end if;
   end Queue_Event;

   --  ------------------------------
   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   --  ------------------------------
   procedure Broadcast (UI      : in out UIView;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is

      Pos : Natural := 0;

      --  Broadcast the event to the component's listeners
      --  and free that event.
      procedure Broadcast (Ev : in out Faces_Event_Access);

      procedure Broadcast (Ev : in out Faces_Event_Access) is
      begin
         if Ev /= null then
            declare
               C  : constant Base.UIComponent_Access := Ev.Get_Component;
            begin
               C.Broadcast (Ev, Context);
            end;
            Free (Ev);
         end if;
      end Broadcast;

      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         UIView'Class (Parent.all).Broadcast (Phase, Context);
      else
         --  Dispatch events in the order in which they were queued.
         --  More events could be queued as a result of the dispatch.
         --  After dispatching an event, it is freed but not removed
         --  from the event queue (the access will be cleared).
         loop
            exit when Pos > UI.Phase_Events (Phase).Last_Index;
            UI.Phase_Events (Phase).Update_Element (Pos, Broadcast'Access);
            Pos := Pos + 1;
         end loop;

         --  Now, clear the queue.
         UI.Phase_Events (Phase).Clear;
      end if;
   end Broadcast;

   --  ------------------------------
   --  Clear the events that were queued.
   --  ------------------------------
   procedure Clear_Events (UI : in out UIView) is
   begin
      for Phase in UI.Phase_Events'Range loop
         for I in 0 .. UI.Phase_Events (Phase).Last_Index loop
            declare
               Ev : Faces_Event_Access := UI.Phase_Events (Phase).Element (I);
            begin
               Free (Ev);
            end;
         end loop;
         UI.Phase_Events (Phase).Clear;
      end loop;
   end Clear_Events;

   --  ------------------------------
   --  Set the component tree that must be rendered before this view.
   --  This is an internal method used by Steal_Root_Component exclusively.
   --  ------------------------------
   procedure Set_Before_View (UI   : in out UIView'Class;
                              Tree : in Base.UIComponent_Access) is
   begin
      if UI.Left_Tree /= null then
         UI.Log_Error ("Set_Before_View called while there is a tree");
      end if;
      UI.Left_Tree := Tree;
   end Set_Before_View;

   --  ------------------------------
   --  Set the component tree that must be rendered after this view.
   --  This is an internal method used by Steal_Root_Component exclusively.
   --  ------------------------------
   procedure Set_After_View (UI   : in out UIView'Class;
                             Tree : in Base.UIComponent_Access) is
   begin
      if UI.Right_Tree /= null then
         UI.Log_Error ("Set_Before_View called while there is a tree");
      end if;
      UI.Right_Tree := Tree;
   end Set_After_View;

   --  ------------------------------
   --  Finalize the object.
   --  ------------------------------
   overriding
   procedure Finalize (UI : in out UIView) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Base.UIComponent'Class,
                                        Name   => Base.UIComponent_Access);

   begin
      Free (UI.Left_Tree);
      Free (UI.Right_Tree);
      Base.UIComponent (UI).Finalize;
   end Finalize;

   --  ------------------------------
   --  Set the metadata facet on the UIView component.
   --  ------------------------------
   procedure Set_Metadata (UI    : in out UIView;
                           Meta  : in UIViewMetaData_Access;
                           Tag   : access ASF.Views.Nodes.Tag_Node'Class) is
   begin
      if UI.Meta /= null then
         UI.Log_Error ("A <f:metadata> component was already registered.");
--           Delete (UI.Meta);
      end if;
      Meta.Root := UI'Unchecked_Access;
      UI.Meta := Meta;
      UI.Add_Facet (METADATA_FACET_NAME, Meta.all'Access, Tag);
   end Set_Metadata;

   --  ------------------------------
   --  Get the input parameter from the submitted context.  This operation is called by
   --  <tt>Process_Decodes</tt> to retrieve the request parameter associated with the component.
   --  ------------------------------
   overriding
   function Get_Parameter (UI      : in UIViewParameter;
                           Context : in Faces_Context'Class) return String is
      Name : constant String := UI.Get_Attribute ("name", Context);
   begin
      if Name'Length > 0 then
         return Context.Get_Parameter (Name);
      else
         return Html.Forms.UIInput (UI).Get_Parameter (Context);
      end if;
   end Get_Parameter;

   --  ------------------------------
   --  Decode the request and prepare for the execution for the view action.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIViewAction;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      begin
         ASF.Events.Faces.Actions.Post_Event (UI     => UI,
                                              Method => UI.Get_Action_Expression (Context));

      exception
         when EL.Expressions.Invalid_Expression =>
            null;
      end;
   end Process_Decodes;

   --  ------------------------------
   --  Get the root component.
   --  ------------------------------
   function Get_Root (UI      : in UIViewMetaData) return Base.UIComponent_Access is
      Result : Base.UIComponent_Access := UI.Get_Parent;
      Parent : Base.UIComponent_Access := Result.Get_Parent;
   begin
      while Parent /= null loop
         Result := Parent;
         Parent := Parent.Get_Parent;
      end loop;
      return Result;
   end Get_Root;

   --  ------------------------------
   --  Start encoding the UIComponent.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIViewMetaData;
                           Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_Begin (Context);
   end Encode_Begin;

   --  ------------------------------
   --  Encode the children of this component.
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIViewMetaData;
                              Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_Children (Context);
   end Encode_Children;

   --  ------------------------------
   --  Finish encoding the component.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIViewMetaData;
                         Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_End (Context);
   end Encode_End;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   overriding
   procedure Queue_Event (UI    : in out UIViewMetaData;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
   begin
      UI.Root.Queue_Event (Event);
   end Queue_Event;

   --  ------------------------------
   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   --  ------------------------------
   overriding
   procedure Broadcast (UI      : in out UIViewMetaData;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is
   begin
      UI.Root.Broadcast (Phase, Context);
   end Broadcast;

   --  ------------------------------
   --  Clear the events that were queued.
   --  ------------------------------
   overriding
   procedure Clear_Events (UI : in out UIViewMetaData) is
   begin
      UI.Root.Clear_Events;
   end Clear_Events;

end ASF.Components.Core.Views;

Remove unused use clauses

Remove unused use clauses