-----------------------------------------------------------------------
--  views.nodes.jsf -- JSF Core Tag Library
--  Copyright (C) 2010, 2011, 2012, 2013, 2014, 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 ASF.Contexts.Facelets;
with ASF.Validators;

--  The ASF.Views.Nodes.Jsf package implements various JSF Core Tag
--  components which alter the component tree but don't need to create
--  new UI components in the usual way.  The following components are supported:
--
--  <f:attribute name='...' value='...'/>
--  <f:converter converterId='...'/>
--  <f:validateXXX .../>
--  <f:facet name='...'>...</f:facet>
--
--  The f:attribute, f:converter and f:validateXXX tags don't create any
--  component.  The f:facet creates components that are inserted as a facet component
--  in the component tree.
package ASF.Views.Nodes.Jsf is

   --  ------------------------------
   --  Converter Tag
   --  ------------------------------
   --  The Converter_Tag_Node is created in the facelet tree when
   --  the <f:converter> element is found.  When building the component tree,
   --  we have to find the Converter object and attach it to the
   --  parent component.  The parent component must implement the Value_Holder
   --  interface.
   type Converter_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Converter_Tag_Node_Access is access all Converter_Tag_Node'Class;

   --  Create the Converter Tag
   function Create_Converter_Tag_Node (Binding    : in Binding_Type;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.  Get the specified converter and
   --  add it to the parent component.  This operation does not create any
   --  new UIComponent.
   overriding
   procedure Build_Components (Node    : access Converter_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

   --  ------------------------------
   --  Convert Date Time Tag
   --  ------------------------------
   --  The Convert_Date_Time_Tag_Node is created in the facelet tree when
   --  the <f:converterDateTime> element is found.  When building the component tree,
   --  we have to find the Converter object and attach it to the
   --  parent component.  The parent component must implement the Value_Holder
   --  interface.
   type Convert_Date_Time_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Convert_Date_Time_Tag_Node_Access is access all Convert_Date_Time_Tag_Node'Class;

   --  Create the Converter Tag
   function Create_Convert_Date_Time_Tag_Node (Binding    : in Binding_Type;
                                               Line       : in Views.Line_Info;
                                               Parent     : in Views.Nodes.Tag_Node_Access;
                                               Attributes : in Nodes.Tag_Attribute_Array_Access)
                                               return Views.Nodes.Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.  Get the specified converter and
   --  add it to the parent component.  This operation does not create any
   --  new UIComponent.
   overriding
   procedure Build_Components (Node    : access Convert_Date_Time_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

   --  ------------------------------
   --  Validator Tag
   --  ------------------------------
   --  The Validator_Tag_Node is created in the facelet tree when
   --  the <f:validateXXX> element is found.  When building the component tree,
   --  we have to find the Validator object and attach it to the
   --  parent component.  The parent component must implement the Editable_Value_Holder
   --  interface.
   type Validator_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Validator_Tag_Node_Access is access all Validator_Tag_Node'Class;

   --  Create the Validator Tag
   function Create_Validator_Tag_Node (Binding    : in Binding_Type;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access;

   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   procedure Get_Validator (Node      : in Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean);

   --  Get the specified validator and add it to the parent component.
   --  This operation does not create any new UIComponent.
   overriding
   procedure Build_Components (Node    : access Validator_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

   --  ------------------------------
   --  Range Validator Tag
   --  ------------------------------
   --  The Range_Validator_Tag_Node is created in the facelet tree when
   --  the <f:validateLongRange> element is found.
   --  The parent component must implement the Editable_Value_Holder
   --  interface.
   type Range_Validator_Tag_Node is new Validator_Tag_Node with private;
   type Range_Validator_Tag_Node_Access is access all Range_Validator_Tag_Node'Class;

   --  Create the Range_Validator Tag
   function Create_Range_Validator_Tag_Node (Binding    : in Binding_Type;
                                             Line       : in Views.Line_Info;
                                             Parent     : in Views.Nodes.Tag_Node_Access;
                                             Attributes : in Nodes.Tag_Attribute_Array_Access)
                                             return Views.Nodes.Tag_Node_Access;

   --  Get the validator instance that corresponds to the range validator.
   --  Returns in Validator the validator instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   overriding
   procedure Get_Validator (Node      : in Range_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean);

   --  ------------------------------
   --  Length Validator Tag
   --  ------------------------------
   --  The Length_Validator_Tag_Node is created in the facelet tree when
   --  the <f:validateLength> element is found.  When building the component tree,
   --  we have to find the Validator object and attach it to the
   --  parent component.  The parent component must implement the Editable_Value_Holder
   --  interface.
   type Length_Validator_Tag_Node is new Validator_Tag_Node with private;
   type Length_Validator_Tag_Node_Access is access all Length_Validator_Tag_Node'Class;

   --  Create the Length_Validator Tag.  Verifies that the XML node defines
   --  the minimum or the maximum or both attributes.
   function Create_Length_Validator_Tag_Node (Binding    : in Binding_Type;
                                              Line       : in Views.Line_Info;
                                              Parent     : in Views.Nodes.Tag_Node_Access;
                                              Attributes : in Nodes.Tag_Attribute_Array_Access)
                                              return Views.Nodes.Tag_Node_Access;

   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   overriding
   procedure Get_Validator (Node      : in Length_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean);

   --  ------------------------------
   --  Attribute Tag
   --  ------------------------------
   --  The Attribute_Tag_Node is created in the facelet tree when
   --  the <f:attribute> element is found.  When building the component tree,
   --  an attribute is added to the parent component.
   type Attribute_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Attribute_Tag_Node_Access is access all Attribute_Tag_Node'Class;

   --  Create the Attribute Tag
   function Create_Attribute_Tag_Node (Binding    : in Binding_Type;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  Adds the attribute to the component node.
   --  This operation does not create any new UIComponent.
   overriding
   procedure Build_Components (Node    : access Attribute_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

   --  ------------------------------
   --  Facet Tag
   --  ------------------------------
   --  The Facet_Tag_Node is created in the facelet tree when
   --  the <f:facet> element is found.  After building the component tree,
   --  we have to add the component as a facet element of the parent component.
   --
   type Facet_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Facet_Tag_Node_Access is access all Facet_Tag_Node'Class;

   --  Create the Facet Tag
   function Create_Facet_Tag_Node (Binding    : in Binding_Type;
                                   Line       : in Views.Line_Info;
                                   Parent     : in Views.Nodes.Tag_Node_Access;
                                   Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                   return Views.Nodes.Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the facet component of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Facet_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

   --  ------------------------------
   --  Metadata Tag
   --  ------------------------------
   --  The Metadata_Tag_Node is created in the facelet tree when
   --  the <f:metadata> element is found.  This special component is inserted as a special
   --  facet component on the UIView parent component.
   type Metadata_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Metadata_Tag_Node_Access is access all Metadata_Tag_Node'Class;

   --  Create the Metadata Tag
   function Create_Metadata_Tag_Node (Binding    : in Binding_Type;
                                      Line       : in Views.Line_Info;
                                      Parent     : in Views.Nodes.Tag_Node_Access;
                                      Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                      return Views.Nodes.Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as a metadata information
   --  facet for the UIView parent component.
   overriding
   procedure Build_Components (Node    : access Metadata_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

private

   type Converter_Tag_Node is new Views.Nodes.Tag_Node with record
      Converter : EL.Objects.Object;
   end record;

   type Convert_Date_Time_Tag_Node is new Views.Nodes.Tag_Node with record
      Date_Style : Tag_Attribute_Access;
      Time_Style : Tag_Attribute_Access;
      Locale     : Tag_Attribute_Access;
      Pattern    : Tag_Attribute_Access;
      Format     : Tag_Attribute_Access;
   end record;

   type Validator_Tag_Node is new Views.Nodes.Tag_Node with record
      Validator : EL.Objects.Object;
   end record;

   type Length_Validator_Tag_Node is new Validator_Tag_Node with record
      Minimum : Tag_Attribute_Access;
      Maximum : Tag_Attribute_Access;
   end record;

   type Range_Validator_Tag_Node is new Validator_Tag_Node with record
      Minimum : Tag_Attribute_Access;
      Maximum : Tag_Attribute_Access;
   end record;

   type Attribute_Tag_Node is new Views.Nodes.Tag_Node with record
      Attr       : aliased Tag_Attribute;
      Attr_Name  : Tag_Attribute_Access;
      Value      : Tag_Attribute_Access;
   end record;

   type Facet_Tag_Node is new Views.Nodes.Tag_Node with record
      Facet_Name : Tag_Attribute_Access;
   end record;

   type Metadata_Tag_Node is new Views.Nodes.Tag_Node with null record;

end ASF.Views.Nodes.Jsf;

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

--  The ASF.Views.Nodes.Jsf package implements various JSF Core Tag
--  components which alter the component tree but don't need to create
--  new UI components in the usual way.  The following components are supported:
--
--  <f:attribute name='...' value='...'/>
--  <f:converter converterId='...'/>
--  <f:validateXXX .../>
--  <f:facet name='...'>...</f:facet>
--
--  The f:attribute, f:converter and f:validateXXX tags don't create any
--  component.  The f:facet creates components that are inserted as a facet component
--  in the component tree.
package ASF.Views.Nodes.Jsf is

   --  ------------------------------
   --  Converter Tag
   --  ------------------------------
   --  The Converter_Tag_Node is created in the facelet tree when
   --  the <f:converter> element is found.  When building the component tree,
   --  we have to find the Converter object and attach it to the
   --  parent component.  The parent component must implement the Value_Holder
   --  interface.
   type Converter_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Converter_Tag_Node_Access is access all Converter_Tag_Node'Class;

   --  Create the Converter Tag
   function Create_Converter_Tag_Node (Binding    : in Binding_Type;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.  Get the specified converter and
   --  add it to the parent component.  This operation does not create any
   --  new UIComponent.
   overriding
   procedure Build_Components (Node    : access Converter_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

   --  ------------------------------
   --  Convert Date Time Tag
   --  ------------------------------
   --  The Convert_Date_Time_Tag_Node is created in the facelet tree when
   --  the <f:converterDateTime> element is found.  When building the component tree,
   --  we have to find the Converter object and attach it to the
   --  parent component.  The parent component must implement the Value_Holder
   --  interface.
   type Convert_Date_Time_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Convert_Date_Time_Tag_Node_Access is access all Convert_Date_Time_Tag_Node'Class;

   --  Create the Converter Tag
   function Create_Convert_Date_Time_Tag_Node (Binding    : in Binding_Type;
                                               Line       : in Views.Line_Info;
                                               Parent     : in Views.Nodes.Tag_Node_Access;
                                               Attributes : in Nodes.Tag_Attribute_Array_Access)
                                               return Views.Nodes.Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.  Get the specified converter and
   --  add it to the parent component.  This operation does not create any
   --  new UIComponent.
   overriding
   procedure Build_Components (Node    : access Convert_Date_Time_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

   --  ------------------------------
   --  Validator Tag
   --  ------------------------------
   --  The Validator_Tag_Node is created in the facelet tree when
   --  the <f:validateXXX> element is found.  When building the component tree,
   --  we have to find the Validator object and attach it to the
   --  parent component.  The parent component must implement the Editable_Value_Holder
   --  interface.
   type Validator_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Validator_Tag_Node_Access is access all Validator_Tag_Node'Class;

   --  Create the Validator Tag
   function Create_Validator_Tag_Node (Binding    : in Binding_Type;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access;

   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   procedure Get_Validator (Node      : in Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean);

   --  Get the specified validator and add it to the parent component.
   --  This operation does not create any new UIComponent.
   overriding
   procedure Build_Components (Node    : access Validator_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

   --  ------------------------------
   --  Range Validator Tag
   --  ------------------------------
   --  The Range_Validator_Tag_Node is created in the facelet tree when
   --  the <f:validateLongRange> element is found.
   --  The parent component must implement the Editable_Value_Holder
   --  interface.
   type Range_Validator_Tag_Node is new Validator_Tag_Node with private;
   type Range_Validator_Tag_Node_Access is access all Range_Validator_Tag_Node'Class;

   --  Create the Range_Validator Tag
   function Create_Range_Validator_Tag_Node (Binding    : in Binding_Type;
                                             Line       : in Views.Line_Info;
                                             Parent     : in Views.Nodes.Tag_Node_Access;
                                             Attributes : in Nodes.Tag_Attribute_Array_Access)
                                             return Views.Nodes.Tag_Node_Access;

   --  Get the validator instance that corresponds to the range validator.
   --  Returns in Validator the validator instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   overriding
   procedure Get_Validator (Node      : in Range_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean);

   --  ------------------------------
   --  Length Validator Tag
   --  ------------------------------
   --  The Length_Validator_Tag_Node is created in the facelet tree when
   --  the <f:validateLength> element is found.  When building the component tree,
   --  we have to find the Validator object and attach it to the
   --  parent component.  The parent component must implement the Editable_Value_Holder
   --  interface.
   type Length_Validator_Tag_Node is new Validator_Tag_Node with private;
   type Length_Validator_Tag_Node_Access is access all Length_Validator_Tag_Node'Class;

   --  Create the Length_Validator Tag.  Verifies that the XML node defines
   --  the minimum or the maximum or both attributes.
   function Create_Length_Validator_Tag_Node (Binding    : in Binding_Type;
                                              Line       : in Views.Line_Info;
                                              Parent     : in Views.Nodes.Tag_Node_Access;
                                              Attributes : in Nodes.Tag_Attribute_Array_Access)
                                              return Views.Nodes.Tag_Node_Access;

   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   overriding
   procedure Get_Validator (Node      : in Length_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean);

   --  ------------------------------
   --  Regex Validator Tag
   --  ------------------------------
   --  The Regex_Validator_Tag_Node is created in the facelet tree when
   --  the <f:validateRegex> element is found.  When building the component tree,
   --  we have to find the Validator object and attach it to the
   --  parent component.  The parent component must implement the Editable_Value_Holder
   --  interface.
   type Regex_Validator_Tag_Node is new Validator_Tag_Node with private;
   type Regex_Validator_Tag_Node_Access is access all Regex_Validator_Tag_Node'Class;

   --  Create the Regex_Validator Tag.  Verifies that the XML node defines
   --  the pattern and that it is a valid regular expression.
   function Create_Regex_Validator_Tag_Node (Binding    : in Binding_Type;
                                             Line       : in Views.Line_Info;
                                             Parent     : in Views.Nodes.Tag_Node_Access;
                                             Attributes : in Nodes.Tag_Attribute_Array_Access)
                                            return Views.Nodes.Tag_Node_Access;

   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   overriding
   procedure Get_Validator (Node      : in Regex_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean);

   --  ------------------------------
   --  Attribute Tag
   --  ------------------------------
   --  The Attribute_Tag_Node is created in the facelet tree when
   --  the <f:attribute> element is found.  When building the component tree,
   --  an attribute is added to the parent component.
   type Attribute_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Attribute_Tag_Node_Access is access all Attribute_Tag_Node'Class;

   --  Create the Attribute Tag
   function Create_Attribute_Tag_Node (Binding    : in Binding_Type;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  Adds the attribute to the component node.
   --  This operation does not create any new UIComponent.
   overriding
   procedure Build_Components (Node    : access Attribute_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

   --  ------------------------------
   --  Facet Tag
   --  ------------------------------
   --  The Facet_Tag_Node is created in the facelet tree when
   --  the <f:facet> element is found.  After building the component tree,
   --  we have to add the component as a facet element of the parent component.
   --
   type Facet_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Facet_Tag_Node_Access is access all Facet_Tag_Node'Class;

   --  Create the Facet Tag
   function Create_Facet_Tag_Node (Binding    : in Binding_Type;
                                   Line       : in Views.Line_Info;
                                   Parent     : in Views.Nodes.Tag_Node_Access;
                                   Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                   return Views.Nodes.Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the facet component of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Facet_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

   --  ------------------------------
   --  Metadata Tag
   --  ------------------------------
   --  The Metadata_Tag_Node is created in the facelet tree when
   --  the <f:metadata> element is found.  This special component is inserted as a special
   --  facet component on the UIView parent component.
   type Metadata_Tag_Node is new Views.Nodes.Tag_Node with private;
   type Metadata_Tag_Node_Access is access all Metadata_Tag_Node'Class;

   --  Create the Metadata Tag
   function Create_Metadata_Tag_Node (Binding    : in Binding_Type;
                                      Line       : in Views.Line_Info;
                                      Parent     : in Views.Nodes.Tag_Node_Access;
                                      Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                      return Views.Nodes.Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as a metadata information
   --  facet for the UIView parent component.
   overriding
   procedure Build_Components (Node    : access Metadata_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class);

private

   type Converter_Tag_Node is new Views.Nodes.Tag_Node with record
      Converter : EL.Objects.Object;
   end record;

   type Convert_Date_Time_Tag_Node is new Views.Nodes.Tag_Node with record
      Date_Style : Tag_Attribute_Access;
      Time_Style : Tag_Attribute_Access;
      Locale     : Tag_Attribute_Access;
      Pattern    : Tag_Attribute_Access;
      Format     : Tag_Attribute_Access;
   end record;

   type Validator_Tag_Node is new Views.Nodes.Tag_Node with record
      Validator : EL.Objects.Object;
   end record;

   type Length_Validator_Tag_Node is new Validator_Tag_Node with record
      Minimum : Tag_Attribute_Access;
      Maximum : Tag_Attribute_Access;
   end record;

   type Regex_Validator_Tag_Node is new Validator_Tag_Node with record
      Pattern : Tag_Attribute_Access;
   end record;

   type Range_Validator_Tag_Node is new Validator_Tag_Node with record
      Minimum : Tag_Attribute_Access;
      Maximum : Tag_Attribute_Access;
   end record;

   type Attribute_Tag_Node is new Views.Nodes.Tag_Node with record
      Attr       : aliased Tag_Attribute;
      Attr_Name  : Tag_Attribute_Access;
      Value      : Tag_Attribute_Access;
   end record;

   type Facet_Tag_Node is new Views.Nodes.Tag_Node with record
      Facet_Name : Tag_Attribute_Access;
   end record;

   type Metadata_Tag_Node is new Views.Nodes.Tag_Node with null record;

end ASF.Views.Nodes.Jsf;

Declare Regex_Validator_Tag_Node to describe the <f:validateRegex> tag


-----------------------------------------------------------------------
--  awa-services -- Services
--  Copyright (C) 2011, 2012, 2013, 2014, 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.Task_Attributes;
with ADO.Databases;
with Security.Contexts;

package body AWA.Services.Contexts is

   use type ADO.Databases.Connection_Status;
   use type AWA.Users.Principals.Principal_Access;

   package Task_Context is new Ada.Task_Attributes
     (Service_Context_Access, null);

   --  ------------------------------
   --  Get the application associated with the current service operation.
   --  ------------------------------
   function Get_Application (Ctx : in Service_Context)
                             return AWA.Applications.Application_Access is
   begin
      return Ctx.Application;
   end Get_Application;

   --  ------------------------------
   --  Get the current database connection for reading.
   --  ------------------------------
   function Get_Session (Ctx : in Service_Context_Access) return ADO.Sessions.Session is
   begin
      --  If a master database session was created, use it.
      if Ctx.Master.Get_Status = ADO.Databases.OPEN then
         return ADO.Sessions.Session (Ctx.Master);

      elsif Ctx.Slave.Get_Status /= ADO.Databases.OPEN then
         Ctx.Slave  := Ctx.Application.Get_Session;
      end if;
      return Ctx.Slave;
   end Get_Session;

   --  ------------------------------
   --  Get the current database connection for reading and writing.
   --  ------------------------------
   function Get_Master_Session (Ctx : in Service_Context_Access)
                                return ADO.Sessions.Master_Session is
   begin
      if Ctx.Master.Get_Status /= ADO.Databases.OPEN then
         Ctx.Master := Ctx.Application.Get_Master_Session;
      end if;
      return Ctx.Master;
   end Get_Master_Session;

   --  ------------------------------
   --  Get the current user invoking the service operation.
   --  Returns a null user if there is none.
   --  ------------------------------
   function Get_User (Ctx : in Service_Context) return AWA.Users.Models.User_Ref is
   begin
      if Ctx.Principal = null then
         return AWA.Users.Models.Null_User;
      else
         return Ctx.Principal.Get_User;
      end if;
   end Get_User;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none.
   --  ------------------------------
   function Get_User_Identifier (Ctx : in Service_Context) return ADO.Identifier is
   begin
      if Ctx.Principal = null then
         return ADO.NO_IDENTIFIER;
      else
         return Ctx.Principal.Get_User_Identifier;
      end if;
   end Get_User_Identifier;

   --  ------------------------------
   --  Get the current user session from the user invoking the service operation.
   --  Returns a null session if there is none.
   --  ------------------------------
   function Get_User_Session (Ctx : in Service_Context) return AWA.Users.Models.Session_Ref is
   begin
      if Ctx.Principal = null then
         return AWA.Users.Models.Null_Session;
      else
         return Ctx.Principal.Get_Session;
      end if;
   end Get_User_Session;

   --  ------------------------------
   --  Starts a transaction.
   --  ------------------------------
   procedure Start (Ctx : in out Service_Context) is
   begin
      if Ctx.Transaction = 0 and then not Ctx.Active_Transaction then
         Ctx.Master.Begin_Transaction;
         Ctx.Active_Transaction := True;
      end if;
      Ctx.Transaction := Ctx.Transaction + 1;
   end Start;

   --  ------------------------------
   --  Commits the current transaction.  The database transaction is really committed by the
   --  last Commit called.
   --  ------------------------------
   procedure Commit (Ctx : in out Service_Context) is
   begin
      Ctx.Transaction := Ctx.Transaction - 1;
      if Ctx.Transaction = 0 and then Ctx.Active_Transaction then
         Ctx.Master.Commit;
         Ctx.Active_Transaction := False;
      end if;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.  The database transaction is rollback at the first
   --  call to Rollback.
   --  ------------------------------
   procedure Rollback (Ctx : in out Service_Context) is
   begin
      null;
   end Rollback;

   --  ------------------------------
   --  Get the attribute registered under the given name in the HTTP session.
   --  ------------------------------
   function Get_Session_Attribute (Ctx  : in Service_Context;
                                   Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Ctx, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Session_Attribute;

   --  ------------------------------
   --  Set the attribute registered under the given name in the HTTP session.
   --  ------------------------------
   procedure Set_Session_Attribute (Ctx   : in out Service_Context;
                                    Name  : in String;
                                    Value : in Util.Beans.Objects.Object) is
   begin
      null;
   end Set_Session_Attribute;

   --  ------------------------------
   --  Set the current application and user context.
   --  ------------------------------
   procedure Set_Context (Ctx         : in out Service_Context;
                          Application : in AWA.Applications.Application_Access;
                          Principal   : in AWA.Users.Principals.Principal_Access) is
   begin
      Ctx.Application := Application;
      Ctx.Principal   := Principal;
   end Set_Context;

   --  ------------------------------
   --  Initializes the service context.
   --  ------------------------------
   overriding
   procedure Initialize (Ctx : in out Service_Context) is
      use type AWA.Applications.Application_Access;
   begin
      Ctx.Previous := Task_Context.Value;
      Task_Context.Set_Value (Ctx'Unchecked_Access);
      if Ctx.Previous /= null and then Ctx.Application = null then
         Ctx.Application := Ctx.Previous.Application;
      end if;
   end Initialize;

   --  ------------------------------
   --  Finalize the service context, rollback non-committed transaction, releases any object.
   --  ------------------------------
   overriding
   procedure Finalize (Ctx : in out Service_Context) is
   begin
      --  When the service context is released, we must not have any active transaction.
      --  This means we are leaving the service in an abnormal way such as when an
      --  exception is raised.  If this is the case, rollback the transaction.
      if Ctx.Active_Transaction then
         Ctx.Master.Rollback;
      end if;
      Task_Context.Set_Value (Ctx.Previous);
   end Finalize;

   --  ------------------------------
   --  Get the current service context.
   --  Returns null if the current thread is not associated with any service context.
   --  ------------------------------
   function Current return Service_Context_Access is
   begin
      return Task_Context.Value;
   end Current;

   --  ------------------------------
   --  Run the process procedure on behalf of the specific user and session.
   --  This operation changes temporarily the identity of the current user principal and
   --  executes the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Run_As (User    : in AWA.Users.Models.User_Ref;
                     Session : in AWA.Users.Models.Session_Ref) is
      Ctx       : Service_Context;
      Sec       : Security.Contexts.Security_Context;
      Principal : aliased AWA.Users.Principals.Principal
        := AWA.Users.Principals.Create (User, Session);
   begin
      Ctx.Principal := Principal'Unchecked_Access;
      Sec.Set_Context (Ctx.Application.Get_Security_Manager, Principal'Unchecked_Access);
      Process;
   end Run_As;

end AWA.Services.Contexts;

-----------------------------------------------------------------------
--  awa-services -- Services
--  Copyright (C) 2011, 2012, 2013, 2014, 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.Task_Attributes;
with Security.Contexts;

package body AWA.Services.Contexts is

   use type ADO.Sessions.Connection_Status;
   use type AWA.Users.Principals.Principal_Access;

   package Task_Context is new Ada.Task_Attributes
     (Service_Context_Access, null);

   --  ------------------------------
   --  Get the application associated with the current service operation.
   --  ------------------------------
   function Get_Application (Ctx : in Service_Context)
                             return AWA.Applications.Application_Access is
   begin
      return Ctx.Application;
   end Get_Application;

   --  ------------------------------
   --  Get the current database connection for reading.
   --  ------------------------------
   function Get_Session (Ctx : in Service_Context_Access) return ADO.Sessions.Session is
   begin
      --  If a master database session was created, use it.
      if Ctx.Master.Get_Status = ADO.Sessions.OPEN then
         return ADO.Sessions.Session (Ctx.Master);

      elsif Ctx.Slave.Get_Status /= ADO.Sessions.OPEN then
         Ctx.Slave  := Ctx.Application.Get_Session;
      end if;
      return Ctx.Slave;
   end Get_Session;

   --  ------------------------------
   --  Get the current database connection for reading and writing.
   --  ------------------------------
   function Get_Master_Session (Ctx : in Service_Context_Access)
                                return ADO.Sessions.Master_Session is
   begin
      if Ctx.Master.Get_Status /= ADO.Sessions.OPEN then
         Ctx.Master := Ctx.Application.Get_Master_Session;
      end if;
      return Ctx.Master;
   end Get_Master_Session;

   --  ------------------------------
   --  Get the current user invoking the service operation.
   --  Returns a null user if there is none.
   --  ------------------------------
   function Get_User (Ctx : in Service_Context) return AWA.Users.Models.User_Ref is
   begin
      if Ctx.Principal = null then
         return AWA.Users.Models.Null_User;
      else
         return Ctx.Principal.Get_User;
      end if;
   end Get_User;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none.
   --  ------------------------------
   function Get_User_Identifier (Ctx : in Service_Context) return ADO.Identifier is
   begin
      if Ctx.Principal = null then
         return ADO.NO_IDENTIFIER;
      else
         return Ctx.Principal.Get_User_Identifier;
      end if;
   end Get_User_Identifier;

   --  ------------------------------
   --  Get the current user session from the user invoking the service operation.
   --  Returns a null session if there is none.
   --  ------------------------------
   function Get_User_Session (Ctx : in Service_Context) return AWA.Users.Models.Session_Ref is
   begin
      if Ctx.Principal = null then
         return AWA.Users.Models.Null_Session;
      else
         return Ctx.Principal.Get_Session;
      end if;
   end Get_User_Session;

   --  ------------------------------
   --  Starts a transaction.
   --  ------------------------------
   procedure Start (Ctx : in out Service_Context) is
   begin
      if Ctx.Transaction = 0 and then not Ctx.Active_Transaction then
         Ctx.Master.Begin_Transaction;
         Ctx.Active_Transaction := True;
      end if;
      Ctx.Transaction := Ctx.Transaction + 1;
   end Start;

   --  ------------------------------
   --  Commits the current transaction.  The database transaction is really committed by the
   --  last Commit called.
   --  ------------------------------
   procedure Commit (Ctx : in out Service_Context) is
   begin
      Ctx.Transaction := Ctx.Transaction - 1;
      if Ctx.Transaction = 0 and then Ctx.Active_Transaction then
         Ctx.Master.Commit;
         Ctx.Active_Transaction := False;
      end if;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.  The database transaction is rollback at the first
   --  call to Rollback.
   --  ------------------------------
   procedure Rollback (Ctx : in out Service_Context) is
   begin
      null;
   end Rollback;

   --  ------------------------------
   --  Get the attribute registered under the given name in the HTTP session.
   --  ------------------------------
   function Get_Session_Attribute (Ctx  : in Service_Context;
                                   Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Ctx, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Session_Attribute;

   --  ------------------------------
   --  Set the attribute registered under the given name in the HTTP session.
   --  ------------------------------
   procedure Set_Session_Attribute (Ctx   : in out Service_Context;
                                    Name  : in String;
                                    Value : in Util.Beans.Objects.Object) is
   begin
      null;
   end Set_Session_Attribute;

   --  ------------------------------
   --  Set the current application and user context.
   --  ------------------------------
   procedure Set_Context (Ctx         : in out Service_Context;
                          Application : in AWA.Applications.Application_Access;
                          Principal   : in AWA.Users.Principals.Principal_Access) is
   begin
      Ctx.Application := Application;
      Ctx.Principal   := Principal;
   end Set_Context;

   --  ------------------------------
   --  Initializes the service context.
   --  ------------------------------
   overriding
   procedure Initialize (Ctx : in out Service_Context) is
      use type AWA.Applications.Application_Access;
   begin
      Ctx.Previous := Task_Context.Value;
      Task_Context.Set_Value (Ctx'Unchecked_Access);
      if Ctx.Previous /= null and then Ctx.Application = null then
         Ctx.Application := Ctx.Previous.Application;
      end if;
   end Initialize;

   --  ------------------------------
   --  Finalize the service context, rollback non-committed transaction, releases any object.
   --  ------------------------------
   overriding
   procedure Finalize (Ctx : in out Service_Context) is
   begin
      --  When the service context is released, we must not have any active transaction.
      --  This means we are leaving the service in an abnormal way such as when an
      --  exception is raised.  If this is the case, rollback the transaction.
      if Ctx.Active_Transaction then
         Ctx.Master.Rollback;
      end if;
      Task_Context.Set_Value (Ctx.Previous);
   end Finalize;

   --  ------------------------------
   --  Get the current service context.
   --  Returns null if the current thread is not associated with any service context.
   --  ------------------------------
   function Current return Service_Context_Access is
   begin
      return Task_Context.Value;
   end Current;

   --  ------------------------------
   --  Run the process procedure on behalf of the specific user and session.
   --  This operation changes temporarily the identity of the current user principal and
   --  executes the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Run_As (User    : in AWA.Users.Models.User_Ref;
                     Session : in AWA.Users.Models.Session_Ref) is
      Ctx       : Service_Context;
      Sec       : Security.Contexts.Security_Context;
      Principal : aliased AWA.Users.Principals.Principal
        := AWA.Users.Principals.Create (User, Session);
   begin
      Ctx.Principal := Principal'Unchecked_Access;
      Sec.Set_Context (Ctx.Application.Get_Security_Manager, Principal'Unchecked_Access);
      Process;
   end Run_As;

end AWA.Services.Contexts;

Update to use the ADO.Sessions package for the Connection_Status type


-----------------------------------------------------------------------
--  EL.Contexts -- Default contexts for evaluating an expression
--  Copyright (C) 2009, 2010 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 EL.Variables;
with EL.Variables.Default;
package body EL.Contexts.Default is

   --  ------------------------------
   --  Retrieves the ELResolver associated with this ELcontext.
   --  ------------------------------
   overriding
   function Get_Resolver (Context : Default_Context) return ELResolver_Access is
   begin
      return Context.Resolver;
   end Get_Resolver;

   --  ------------------------------
   --  Set the ELResolver associated with this ELcontext.
   --  ------------------------------
   procedure Set_Resolver (Context  : in out Default_Context;
                           Resolver : in ELResolver_Access) is
   begin
      Context.Resolver := Resolver;
   end Set_Resolver;

   --  ------------------------------
   --  Retrieves the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   function Get_Variable_Mapper (Context : Default_Context)
                                 return access EL.Variables.VariableMapper'Class is
   begin
      return Context.Var_Mapper;
   end Get_Variable_Mapper;

   --  ------------------------------
   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   --  ------------------------------
   overriding
   function Get_Function_Mapper (Context : Default_Context)
                                 return EL.Functions.Function_Mapper_Access is
   begin
      return Context.Function_Mapper;
   end Get_Function_Mapper;

   --  ------------------------------
   --  Set the function mapper to be used when parsing an expression.
   --  ------------------------------
   overriding
   procedure Set_Function_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Functions.Function_Mapper'Class) is
   begin
      Context.Function_Mapper := Mapper.all'Unchecked_Access;
   end Set_Function_Mapper;

   --  ------------------------------
   --  Set the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   procedure Set_Variable_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Variables.VariableMapper'Class) is
      use EL.Variables;
   begin
      if Mapper = null then
         Context.Var_Mapper := null;
      else
         Context.Var_Mapper := Mapper.all'Unchecked_Access;
      end if;
   end Set_Variable_Mapper;

   procedure Set_Variable (Context : in out Default_Context;
                           Name    : in String;
                           Value   : access EL.Beans.Readonly_Bean'Class) is
      use EL.Variables;
   begin
      if Context.Var_Mapper = null then
         Context.Var_Mapper := new EL.Variables.Default.Default_Variable_Mapper;
      end if;
      Context.Var_Mapper.Bind (Name, EL.Objects.To_Object (Value));
   end Set_Variable;

   --  ------------------------------
   --  Get the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   function Get_Value (Resolver : Default_ELResolver;
                       Context  : ELContext'Class;
                       Base     : access EL.Beans.Readonly_Bean'Class;
                       Name     : Unbounded_String) return Object is
      pragma Unreferenced (Context);

      R : Object;
   begin
      if Base /= null then
         return Base.Get_Value (To_String (Name));
      end if;

      declare
         Pos : constant Bean_Maps.Cursor := Resolver.Map.Find (Name);
      begin
         if Bean_Maps.Has_Element (Pos) then
            return Bean_Maps.Element (Pos);
         end if;
      end;
      return R;
   end Get_Value;

   --  ------------------------------
   --  Set the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   procedure Set_Value (Resolver : in Default_ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access EL.Beans.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in Object) is
   begin
      null;
   end Set_Value;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : access EL.Beans.Readonly_Bean'Class) is
   begin
      Resolver.Register (Name, To_Object (Value));
   end Register;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : in EL.Objects.Object) is
   begin
      Bean_Maps.Include (Resolver.Map, Name, Value);
   end Register;

end EL.Contexts.Default;

-----------------------------------------------------------------------
--  EL.Contexts -- Default contexts for evaluating an expression
--  Copyright (C) 2009, 2010 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 EL.Variables;
with EL.Variables.Default;
package body EL.Contexts.Default is

   --  ------------------------------
   --  Retrieves the ELResolver associated with this ELcontext.
   --  ------------------------------
   overriding
   function Get_Resolver (Context : Default_Context) return ELResolver_Access is
   begin
      return Context.Resolver;
   end Get_Resolver;

   --  ------------------------------
   --  Set the ELResolver associated with this ELcontext.
   --  ------------------------------
   procedure Set_Resolver (Context  : in out Default_Context;
                           Resolver : in ELResolver_Access) is
   begin
      Context.Resolver := Resolver;
   end Set_Resolver;

   --  ------------------------------
   --  Retrieves the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   function Get_Variable_Mapper (Context : Default_Context)
                                 return access EL.Variables.VariableMapper'Class is
   begin
      return Context.Var_Mapper;
   end Get_Variable_Mapper;

   --  ------------------------------
   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   --  ------------------------------
   overriding
   function Get_Function_Mapper (Context : Default_Context)
                                 return EL.Functions.Function_Mapper_Access is
   begin
      return Context.Function_Mapper;
   end Get_Function_Mapper;

   --  ------------------------------
   --  Set the function mapper to be used when parsing an expression.
   --  ------------------------------
   overriding
   procedure Set_Function_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Functions.Function_Mapper'Class) is
   begin
      if Mapper = null then
         Context.Function_Mapper := null;
      else
         Context.Function_Mapper := Mapper.all'Unchecked_Access;
      end if;
   end Set_Function_Mapper;

   --  ------------------------------
   --  Set the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   procedure Set_Variable_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Variables.VariableMapper'Class) is
      use EL.Variables;
   begin
      if Mapper = null then
         Context.Var_Mapper := null;
      else
         Context.Var_Mapper := Mapper.all'Unchecked_Access;
      end if;
   end Set_Variable_Mapper;

   procedure Set_Variable (Context : in out Default_Context;
                           Name    : in String;
                           Value   : access EL.Beans.Readonly_Bean'Class) is
      use EL.Variables;
   begin
      if Context.Var_Mapper = null then
         Context.Var_Mapper := new EL.Variables.Default.Default_Variable_Mapper;
      end if;
      Context.Var_Mapper.Bind (Name, EL.Objects.To_Object (Value));
   end Set_Variable;

   --  ------------------------------
   --  Get the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   function Get_Value (Resolver : Default_ELResolver;
                       Context  : ELContext'Class;
                       Base     : access EL.Beans.Readonly_Bean'Class;
                       Name     : Unbounded_String) return Object is
      pragma Unreferenced (Context);

      R : Object;
   begin
      if Base /= null then
         return Base.Get_Value (To_String (Name));
      end if;

      declare
         Pos : constant Bean_Maps.Cursor := Resolver.Map.Find (Name);
      begin
         if Bean_Maps.Has_Element (Pos) then
            return Bean_Maps.Element (Pos);
         end if;
      end;
      return R;
   end Get_Value;

   --  ------------------------------
   --  Set the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   procedure Set_Value (Resolver : in Default_ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access EL.Beans.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in Object) is
   begin
      null;
   end Set_Value;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : access EL.Beans.Readonly_Bean'Class) is
   begin
      Resolver.Register (Name, To_Object (Value));
   end Register;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : in EL.Objects.Object) is
   begin
      Bean_Maps.Include (Resolver.Map, Name, Value);
   end Register;

end EL.Contexts.Default;

Fix Set_Variable_Mapper to allow to set a null function mapper.


-----------------------------------------------------------------------
--  EL.Contexts -- Default contexts for evaluating an expression
--  Copyright (C) 2009, 2010 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 EL.Variables;
with EL.Variables.Default;
package body EL.Contexts.Default is

   --  ------------------------------
   --  Retrieves the ELResolver associated with this ELcontext.
   --  ------------------------------
   overriding
   function Get_Resolver (Context : Default_Context) return ELResolver_Access is
   begin
      return Context.Resolver;
   end Get_Resolver;

   --  ------------------------------
   --  Set the ELResolver associated with this ELcontext.
   --  ------------------------------
   procedure Set_Resolver (Context  : in out Default_Context;
                           Resolver : in ELResolver_Access) is
   begin
      Context.Resolver := Resolver;
   end Set_Resolver;

   --  ------------------------------
   --  Retrieves the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   function Get_Variable_Mapper (Context : Default_Context)
                                 return access EL.Variables.VariableMapper'Class is
   begin
      return Context.Var_Mapper;
   end Get_Variable_Mapper;

   --  ------------------------------
   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   --  ------------------------------
   overriding
   function Get_Function_Mapper (Context : Default_Context)
                                 return EL.Functions.Function_Mapper_Access is
   begin
      return Context.Function_Mapper;
   end Get_Function_Mapper;

   --  ------------------------------
   --  Set the function mapper to be used when parsing an expression.
   --  ------------------------------
   overriding
   procedure Set_Function_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Functions.Function_Mapper'Class) is
   begin
      if Mapper = null then
         Context.Function_Mapper := null;
      else
         Context.Function_Mapper := Mapper.all'Unchecked_Access;
      end if;
   end Set_Function_Mapper;

   --  ------------------------------
   --  Set the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   procedure Set_Variable_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Variables.VariableMapper'Class) is
      use EL.Variables;
   begin
      if Mapper = null then
         Context.Var_Mapper := null;
      else
         Context.Var_Mapper := Mapper.all'Unchecked_Access;
      end if;
   end Set_Variable_Mapper;

   procedure Set_Variable (Context : in out Default_Context;
                           Name    : in String;
                           Value   : access EL.Beans.Readonly_Bean'Class) is
      use EL.Variables;
   begin
      if Context.Var_Mapper = null then
         Context.Var_Mapper := new EL.Variables.Default.Default_Variable_Mapper;
      end if;
      Context.Var_Mapper.Bind (Name, EL.Objects.To_Object (Value));
   end Set_Variable;

   --  ------------------------------
   --  Get the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   function Get_Value (Resolver : Default_ELResolver;
                       Context  : ELContext'Class;
                       Base     : access EL.Beans.Readonly_Bean'Class;
                       Name     : Unbounded_String) return Object is
      pragma Unreferenced (Context);

      R : Object;
   begin
      if Base /= null then
         return Base.Get_Value (To_String (Name));
      end if;

      declare
         Pos : constant Bean_Maps.Cursor := Resolver.Map.Find (Name);
      begin
         if Bean_Maps.Has_Element (Pos) then
            return Bean_Maps.Element (Pos);
         end if;
      end;
      return R;
   end Get_Value;

   --  ------------------------------
   --  Set the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   procedure Set_Value (Resolver : in Default_ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access EL.Beans.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in Object) is
   begin
      null;
   end Set_Value;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : access EL.Beans.Readonly_Bean'Class) is
   begin
      Resolver.Register (Name, To_Object (Value));
   end Register;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : in EL.Objects.Object) is
   begin
      Bean_Maps.Include (Resolver.Map, Name, Value);
   end Register;

end EL.Contexts.Default;

-----------------------------------------------------------------------
--  EL.Contexts -- Default contexts for evaluating an expression
--  Copyright (C) 2009, 2010 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 EL.Variables.Default;
package body EL.Contexts.Default is

   --  ------------------------------
   --  Retrieves the ELResolver associated with this ELcontext.
   --  ------------------------------
   overriding
   function Get_Resolver (Context : Default_Context) return ELResolver_Access is
   begin
      return Context.Resolver;
   end Get_Resolver;

   --  ------------------------------
   --  Set the ELResolver associated with this ELcontext.
   --  ------------------------------
   procedure Set_Resolver (Context  : in out Default_Context;
                           Resolver : in ELResolver_Access) is
   begin
      Context.Resolver := Resolver;
   end Set_Resolver;

   --  ------------------------------
   --  Retrieves the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   function Get_Variable_Mapper (Context : Default_Context)
                                 return access EL.Variables.VariableMapper'Class is
   begin
      return Context.Var_Mapper;
   end Get_Variable_Mapper;

   --  ------------------------------
   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   --  ------------------------------
   overriding
   function Get_Function_Mapper (Context : Default_Context)
                                 return EL.Functions.Function_Mapper_Access is
   begin
      return Context.Function_Mapper;
   end Get_Function_Mapper;

   --  ------------------------------
   --  Set the function mapper to be used when parsing an expression.
   --  ------------------------------
   overriding
   procedure Set_Function_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Functions.Function_Mapper'Class) is
   begin
      if Mapper = null then
         Context.Function_Mapper := null;
      else
         Context.Function_Mapper := Mapper.all'Unchecked_Access;
      end if;
   end Set_Function_Mapper;

   --  ------------------------------
   --  Set the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   procedure Set_Variable_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Variables.VariableMapper'Class) is
      use EL.Variables;
   begin
      if Mapper = null then
         Context.Var_Mapper := null;
      else
         Context.Var_Mapper := Mapper.all'Unchecked_Access;
      end if;
   end Set_Variable_Mapper;

   procedure Set_Variable (Context : in out Default_Context;
                           Name    : in String;
                           Value   : access EL.Beans.Readonly_Bean'Class) is
      use EL.Variables;
   begin
      if Context.Var_Mapper = null then
         Context.Var_Mapper := new EL.Variables.Default.Default_Variable_Mapper;
      end if;
      Context.Var_Mapper.Bind (Name, EL.Objects.To_Object (Value));
   end Set_Variable;

   --  ------------------------------
   --  Get the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   function Get_Value (Resolver : Default_ELResolver;
                       Context  : ELContext'Class;
                       Base     : access EL.Beans.Readonly_Bean'Class;
                       Name     : Unbounded_String) return Object is
      pragma Unreferenced (Context);

      R : Object;
   begin
      if Base /= null then
         return Base.Get_Value (To_String (Name));
      end if;

      declare
         Pos : constant Bean_Maps.Cursor := Resolver.Map.Find (Name);
      begin
         if Bean_Maps.Has_Element (Pos) then
            return Bean_Maps.Element (Pos);
         end if;
      end;
      return R;
   end Get_Value;

   --  ------------------------------
   --  Set the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   procedure Set_Value (Resolver : in Default_ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access EL.Beans.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in Object) is
   begin
      null;
   end Set_Value;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : access EL.Beans.Readonly_Bean'Class) is
   begin
      Resolver.Register (Name, To_Object (Value));
   end Register;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : in EL.Objects.Object) is
   begin
      Bean_Maps.Include (Resolver.Map, Name, Value);
   end Register;

end EL.Contexts.Default;

Remove unused with clause

Remove unused with clause


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

with Ada.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Beans.Methods;

with AWA.Events;
with AWA.Users.Models;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
package AWA.Workspaces.Beans is

   type Invitation_Bean is new AWA.Workspaces.Models.Invitation_Bean with record
      Module  : AWA.Workspaces.Modules.Workspace_Module_Access := null;
      Inviter : AWA.Users.Models.User_Ref;
   end record;
   type Invitation_Bean_Access is access all Invitation_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Invitation_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   overriding
   procedure Load (Bean : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   overriding
   procedure Accept_Invitation (Bean    : in out Invitation_Bean;
                                Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   overriding
   procedure Send (Bean    : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Invitation_Bean bean instance.
   function Create_Invitation_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Workspaces_Bean is new Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with record
      Module : AWA.Workspaces.Modules.Workspace_Module_Access := null;
      Count  : Natural := 0;
   end record;
   type Workspaces_Bean_Access is access all Workspaces_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Workspaces_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Workspaces_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Workspaces_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access;

   --  Event action called to create the workspace when the given event is posted.
   procedure Create (Bean  : in out Workspaces_Bean;
                     Event : in AWA.Events.Module_Event'Class);

   --  Example of action method.
   procedure Action (Bean    : in out Workspaces_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Workspaces_Bean bean instance.
   function Create_Workspaces_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access;

   type Member_List_Bean is new AWA.Workspaces.Models.Member_List_Bean with record
      Module       : AWA.Workspaces.Modules.Workspace_Module_Access;

      --  The list of workspace members.
      Members      : aliased AWA.Workspaces.Models.Member_Info_List_Bean;
      Members_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Member_List_Bean_Access is access all Member_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Member_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Load the list of members.
   overriding
   procedure Load (Into    : in out Member_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Member_List_Bean bean instance.
   function Create_Member_List_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Workspaces.Beans;

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

with Ada.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Beans.Methods;

with AWA.Events;
with AWA.Users.Models;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
package AWA.Workspaces.Beans is

   type Member_Bean is new AWA.Workspaces.Models.Member_Bean with record
      Module  : AWA.Workspaces.Modules.Workspace_Module_Access := null;
   end record;
   type Member_Bean_Access is access all Member_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Member_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   overriding
   procedure Load (Bean : in out Member_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   overriding
   procedure Delete (Bean : in out Member_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Member_Bean bean instance.
   function Create_Member_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access;

   type Invitation_Bean is new AWA.Workspaces.Models.Invitation_Bean with record
      Module  : AWA.Workspaces.Modules.Workspace_Module_Access := null;
      Inviter : AWA.Users.Models.User_Ref;
   end record;
   type Invitation_Bean_Access is access all Invitation_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Invitation_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   overriding
   procedure Load (Bean : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   overriding
   procedure Accept_Invitation (Bean    : in out Invitation_Bean;
                                Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   overriding
   procedure Send (Bean    : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Invitation_Bean bean instance.
   function Create_Invitation_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Workspaces_Bean is new Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with record
      Module : AWA.Workspaces.Modules.Workspace_Module_Access := null;
      Count  : Natural := 0;
   end record;
   type Workspaces_Bean_Access is access all Workspaces_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Workspaces_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Workspaces_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Workspaces_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access;

   --  Event action called to create the workspace when the given event is posted.
   procedure Create (Bean  : in out Workspaces_Bean;
                     Event : in AWA.Events.Module_Event'Class);

   --  Example of action method.
   procedure Action (Bean    : in out Workspaces_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Workspaces_Bean bean instance.
   function Create_Workspaces_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access;

   type Member_List_Bean is new AWA.Workspaces.Models.Member_List_Bean with record
      Module       : AWA.Workspaces.Modules.Workspace_Module_Access;

      --  The list of workspace members.
      Members      : aliased AWA.Workspaces.Models.Member_Info_List_Bean;
      Members_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Member_List_Bean_Access is access all Member_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Member_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Load the list of members.
   overriding
   procedure Load (Into    : in out Member_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Member_List_Bean bean instance.
   function Create_Member_List_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Workspaces.Beans;

Declare the Member_Bean type with its operations