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

--  The ASF.Contexts.Writer defines the response writer to
--  write the rendered result to the response stream.  The IOWriter
--  interface defines the procedure for writing the buffer to the output
--  stream.  The Response_Writer is the main type that provides
--  various methods for writing the content.
--
--  The result stream is encoded according to the encoding type.
--
with Unicode.Encodings;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with EL.Objects;
with Util.Beans.Objects;
with ASF.Streams;
package ASF.Contexts.Writer is

   use Ada.Strings.Unbounded;
   use Ada.Strings.Wide_Wide_Unbounded;

   --  ------------------------------
   --  IO Writer
   --  ------------------------------
   type IOWriter is limited interface;
   procedure Write (Stream : in out IOWriter;
                    Buffer : in Ada.Streams.Stream_Element_Array) is abstract;

   --  ------------------------------
   --  Response Writer
   --  ------------------------------
   type Response_Writer is new ASF.Streams.Print_Stream with private;
   type Response_Writer_Access is access all Response_Writer'Class;

   --  Backward compatibility
   subtype ResponseWriter is Response_Writer;
   pragma Obsolescent (Entity => ResponseWriter);

   subtype ResponseWriter_Access is Response_Writer_Access;
   pragma Obsolescent (Entity => ResponseWriter_Access);

   --  Initialize the response stream for the given content type and
   --  encoding.  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream       : in out Response_Writer;
                         Content_Type : in String;
                         Encoding     : in String;
                         Output       : in ASF.Streams.Print_Stream);

   --  Get the content type.
   function Get_Content_Type (Stream : in Response_Writer) return String;

   --  Get the character encoding.
   function Get_Encoding (Stream : in Response_Writer) return String;

   --  Close the current XML entity if an entity was started
   procedure Close_Current (Stream : in out Response_Writer'Class);

   --  Start an XML element with the given name.
   procedure Start_Element (Stream : in out Response_Writer;
                            Name   : in String);

   --  Start an optional XML element with the given name.
   --  The element is written only if it has at least one attribute.
   --  The optional XML element must not contain other XML entities.
   procedure Start_Optional_Element (Stream : in out Response_Writer;
                                     Name   : in String);

   --  Closes an XML element of the given name.
   procedure End_Element (Stream : in out Response_Writer;
                          Name   : in String);

   --  Closes an optional XML element of the given name.
   --  The ending tag is written only if the start tag was written.
   procedure End_Optional_Element (Stream : in out Response_Writer;
                                   Name   : in String);

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   procedure Write_Element (Stream   : in out Response_Writer;
                            Name     : in String;
                            Content  : in String);

   procedure Write_Wide_Element (Stream   : in out Response_Writer;
                                 Name     : in String;
                                 Content  : in Wide_Wide_String);

   procedure Write_Wide_Element (Stream   : in out Response_Writer;
                                 Name     : in String;
                                 Content  : in Unbounded_Wide_Wide_String);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in String);

   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in Unbounded_String);

   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in EL.Objects.Object);

   procedure Write_Wide_Attribute (Stream : in out Response_Writer;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String);

   procedure Write_Wide_Attribute (Stream : in out Response_Writer;
                                   Name   : in String;
                                   Value  : in Unbounded_Wide_Wide_String);

   --  Write a text escaping any character as necessary.
   procedure Write_Text (Stream : in out Response_Writer;
                         Text   : in String);
   procedure Write_Text (Stream : in out Response_Writer;
                         Text   : in Unbounded_String);
   procedure Write_Wide_Text (Stream : in out Response_Writer;
                              Text   : in Wide_Wide_String);
   procedure Write_Wide_Text (Stream : in out Response_Writer;
                              Text   : in Unbounded_Wide_Wide_String);
   procedure Write_Text (Stream : in out Response_Writer;
                         Value  : in EL.Objects.Object);

   --  Write a character on the response stream and escape that character
   --  as necessary.
   procedure Write_Char (Stream : in out Response_Writer;
                         Char   : in Character);

   --  Write a character on the response stream and escape that character
   --  as necessary.
   procedure Write_Wide_Char (Stream : in out Response_Writer;
                              Char   : in Wide_Wide_Character);

   --  Write a string on the stream.
   procedure Write (Stream : in out Response_Writer;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write_Raw (Stream : in out Response_Writer;
                        Item   : in String);

   --  Write a raw wide string on the stream.
   procedure Write_Wide_Raw (Stream : in out Response_Writer;
                             Item   : in Wide_Wide_String);

   --  ------------------------------
   --  Javascript Support
   --  ------------------------------
   --  To optimize the execution of Javascript page code, ASF components can queue some
   --  javascript code and have it merged and executed in a single

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

--  The ASF.Contexts.Writer defines the response writer to
--  write the rendered result to the response stream.  The IOWriter
--  interface defines the procedure for writing the buffer to the output
--  stream.  The Response_Writer is the main type that provides
--  various methods for writing the content.
--
--  The result stream is encoded according to the encoding type.
--
with Unicode.Encodings;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with EL.Objects;
with Util.Beans.Objects;
with ASF.Streams;
package ASF.Contexts.Writer is

   use Ada.Strings.Unbounded;
   use Ada.Strings.Wide_Wide_Unbounded;

   --  ------------------------------
   --  IO Writer
   --  ------------------------------
   type IOWriter is limited interface;
   procedure Write (Stream : in out IOWriter;
                    Buffer : in Ada.Streams.Stream_Element_Array) is abstract;

   --  ------------------------------
   --  Response Writer
   --  ------------------------------
   type Response_Writer is new ASF.Streams.Print_Stream with private;
   type Response_Writer_Access is access all Response_Writer'Class;

   --  Backward compatibility
   subtype ResponseWriter is Response_Writer;
   pragma Obsolescent (Entity => ResponseWriter);

   subtype ResponseWriter_Access is Response_Writer_Access;
   pragma Obsolescent (Entity => ResponseWriter_Access);

   --  Initialize the response stream for the given content type and
   --  encoding.  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream       : in out Response_Writer;
                         Content_Type : in String;
                         Encoding     : in String;
                         Output       : in ASF.Streams.Print_Stream);

   --  Get the content type.
   function Get_Content_Type (Stream : in Response_Writer) return String;

   --  Get the character encoding.
   function Get_Encoding (Stream : in Response_Writer) return String;

   --  Close the current XML entity if an entity was started
   procedure Close_Current (Stream : in out Response_Writer'Class);

   --  Start an XML element with the given name.
   procedure Start_Element (Stream : in out Response_Writer;
                            Name   : in String);

   --  Start an optional XML element with the given name.
   --  The element is written only if it has at least one attribute.
   --  The optional XML element must not contain other XML entities.
   procedure Start_Optional_Element (Stream : in out Response_Writer;
                                     Name   : in String);

   --  Closes an XML element of the given name.
   procedure End_Element (Stream : in out Response_Writer;
                          Name   : in String);

   --  Closes an optional XML element of the given name.
   --  The ending tag is written only if the start tag was written.
   procedure End_Optional_Element (Stream : in out Response_Writer;
                                   Name   : in String);

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   procedure Write_Element (Stream   : in out Response_Writer;
                            Name     : in String;
                            Content  : in String);

   procedure Write_Wide_Element (Stream   : in out Response_Writer;
                                 Name     : in String;
                                 Content  : in Wide_Wide_String);

   procedure Write_Wide_Element (Stream   : in out Response_Writer;
                                 Name     : in String;
                                 Content  : in Unbounded_Wide_Wide_String);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in String);

   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in Unbounded_String);

   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in EL.Objects.Object);

   procedure Write_Wide_Attribute (Stream : in out Response_Writer;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String);

   procedure Write_Wide_Attribute (Stream : in out Response_Writer;
                                   Name   : in String;
                                   Value  : in Unbounded_Wide_Wide_String);

   --  Write a text escaping any character as necessary.
   procedure Write_Text (Stream : in out Response_Writer;
                         Text   : in String);
   procedure Write_Text (Stream : in out Response_Writer;
                         Text   : in Unbounded_String);
   procedure Write_Wide_Text (Stream : in out Response_Writer;
                              Text   : in Wide_Wide_String);
   procedure Write_Wide_Text (Stream : in out Response_Writer;
                              Text   : in Unbounded_Wide_Wide_String);
   procedure Write_Text (Stream : in out Response_Writer;
                         Value  : in EL.Objects.Object);

   --  Write a character on the response stream and escape that character
   --  as necessary.
   procedure Write_Char (Stream : in out Response_Writer;
                         Char   : in Character);

   --  Write a character on the response stream and escape that character
   --  as necessary.
   procedure Write_Wide_Char (Stream : in out Response_Writer;
                              Char   : in Wide_Wide_Character);

   --  Write a string on the stream.
   procedure Write (Stream : in out Response_Writer;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write_Raw (Stream : in out Response_Writer;
                        Item   : in String);

   --  Write a raw wide string on the stream.
   procedure Write_Raw (Stream : in out Response_Writer;
                        Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Write a raw wide string on the stream.
   procedure Write_Wide_Raw (Stream : in out Response_Writer;
                             Item   : in Wide_Wide_String);

   --  ------------------------------
   --  Javascript Support
   --  ------------------------------
   --  To optimize the execution of Javascript page code, ASF components can queue some
   --  javascript code and have it merged and executed in a single

Fix compilation warning

Fix compilation warning


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

   type Worker_Type (Count : Positive) is limited private;

   procedure Start (Worker   : in out Worker_Type;
                    Strategy : in Babel.Strategies.Strategy_Type_Access);

private

   task type Worker_Task is
      entry Start (Strategy : in Babel.Strategies.Strategy_Type_Access);
   end Worker_Task;

   type Worker_Task_Array is array (Positive range <>) of Worker_Task;

   type Worker_Type (Count : Positive) is limited record
      Workers : Worker_Task_Array (1 .. Count);
   end record;

end Babel.Strategies.Workers;

-----------------------------------------------------------------------
--  babel-strategies-workers -- Tasks that perform strategy work
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
generic
   type Worker_Strategy is limited new Babel.Strategies.Strategy_Type with private;
package Babel.Strategies.Workers is

   type Worker_Type (Count : Positive) is limited private;

   procedure Configure (Worker  : in out Worker_Type;
                        Process : not null access procedure (S : in out Worker_Strategy));

   procedure Start (Worker   : in out Worker_Type);

   procedure Finish (Worker   : in out Worker_Type;
                     Database : in out Babel.Base.Database'Class);

private

   task type Worker_Task is
      entry Start (Strategy : in Babel.Strategies.Strategy_Type_Access);

      entry Finish (Database : in out Babel.Base.Database'Class);
   end Worker_Task;

   type Worker_Task_Array is array (Positive range <>) of Worker_Task;
   type Strategy_Array is array (Positive range <>) of aliased Worker_Strategy;

   type Worker_Type (Count : Positive) is limited record
      Workers    : Worker_Task_Array (1 .. Count);
      Strategies : Strategy_Array (1 .. Count);
   end record;

end Babel.Strategies.Workers;

Change to a generic package and define a table of strategy objects Declare the Configure procedure


-----------------------------------------------------------------------
--  akt-commands-info -- Info command to describe the current configuration
--  Copyright (C) 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.
-----------------------------------------------------------------------
package body AWA.Commands.Info is

   use type AWA.Modules.Module_Access;

   --  ------------------------------
   --  Print the configuration identified by the given name.
   --  ------------------------------
   procedure Print (Command     : in out Command_Type;
                    Name        : in String;
                    Value       : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      pragma Unreferenced (Default);

      Pos   : Natural;
   begin
      Context.Console.Start_Row;
      Context.Console.Print_Field (1, Name);
      Pos := Value'First;
      while Pos <= Value'Last loop
         if Value'Last - Pos > Command.Value_Length then
            Context.Console.Print_Field (2, Value (Pos .. Pos + Command.Value_Length - 1));
            Pos := Pos + Command.Value_Length;
            Context.Console.End_Row;
            Context.Console.Start_Row;
            Context.Console.Print_Field (1, "");
         else
            Context.Console.Print_Field (2, Value (Pos .. Value'Last));
            Pos := Pos + Value'Length;
         end if;
      end loop;
      Context.Console.End_Row;
   end Print;

   procedure Print (Command     : in out Command_Type;
                    Application : in out AWA.Applications.Application'Class;
                    Name        : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      Value : constant String := Application.Get_Init_Parameter (Name, Default);
   begin
      Command.Print (Name, Value, Default, Context);
   end Print;

   procedure Print (Command     : in out Command_Type;
                    Module      : in AWA.Modules.Module'Class;
                    Name        : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      Value : constant String := Module.Get_Config (Name, Default);
   begin
      Command.Print (Module.Get_Name & "." & Name, Value, Default, Context);
   end Print;

   --  ------------------------------
   --  Print the configuration about the application.
   --  ------------------------------
   overriding
   procedure Execute (Command     : in out Command_Type;
                      Application : in out AWA.Applications.Application'Class;
                      Args        : in Argument_List'Class;
                      Context     : in out Context_Type) is
      pragma Unreferenced (Args);

      Module : AWA.Modules.Module_Access;
   begin
      if Command.Long_List then
         Command.Value_Length := Natural'Last;
      end if;
      Application.Load_Bundle (Name   => "commands",
                               Locale => "en",
                               Bundle => Command.Bundle);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Database configuration");
      Context.Console.Notice (N_INFO, "----------------------");

      Command.Print (Application, "database", "", Context);
      Command.Print (Application, "ado.queries.paths", "", Context);
      Command.Print (Application, "ado.queries.load", "", Context);
      Command.Print (Application, "ado.drivers.load", "", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Server faces configuration");
      Context.Console.Notice (N_INFO, "--------------------------");

      Command.Print (Application, "view.dir",
                     ASF.Applications.DEF_VIEW_DIR, Context);
      Command.Print (Application, "view.escape_unknown_tags",
                     ASF.Applications.DEF_ESCAPE_UNKNOWN_TAGS, Context);
      Command.Print (Application, "view.ext",
                     ASF.Applications.DEF_VIEW_EXT, Context);
      Command.Print (Application, "view.file_ext",
                     ASF.Applications.DEF_VIEW_FILE_EXT, Context);
      Command.Print (Application, "view.ignore_spaces",
                     ASF.Applications.DEF_IGNORE_WHITE_SPACES, Context);
      Command.Print (Application, "view.ignore_empty_lines",
                     ASF.Applications.DEF_IGNORE_EMPTY_LINES, Context);
      Command.Print (Application, "view.static.dir",
                     ASF.Applications.DEF_STATIC_DIR, Context);
      Command.Print (Application, "bundle.dir", "bundles", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "AWA Application");
      Context.Console.Notice (N_INFO, "--------------------------");
      Command.Print (Application, "app_name", "", Context);
      Command.Print (Application, "app_search_dirs", ".", Context);
      Command.Print (Application, "app.modules.dir", "", Context);
      Command.Print (Application, "app_url_base", "", Context);
      Command.Print (Application, "awa_url_base", "", Context);
      Command.Print (Application, "awa_url_host", "", Context);
      Command.Print (Application, "awa_url_port", "", Context);
      Command.Print (Application, "awa_url_scheme", "", Context);
      Command.Print (Application, "app.config", "awa.xml", Context);
      Command.Print (Application, "app.config.plugins", "", Context);
      Command.Print (Application, "contextPath", "", Context);
      Command.Print (Application, "awa_dispatcher_count", "", Context);
      Command.Print (Application, "awa_dispatcher_priority", "", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Users Module");
      Context.Console.Notice (N_INFO, "------------");
      Command.Print (Application, "openid.realm", "", Context);
      Command.Print (Application, "openid.callback_url", "", Context);
      Command.Print (Application, "openid.success_url", "", Context);
      Command.Print (Application, "auth.url.orange", "", Context);
      Command.Print (Application, "auth.provider.oranger", "", Context);
      Command.Print (Application, "auth.url.yahoo", "", Context);
      Command.Print (Application, "auth.provider.yahoo", "", Context);
      Command.Print (Application, "auth.url.google", "", Context);
      Command.Print (Application, "auth.provider.google", "", Context);
      Command.Print (Application, "auth.url.facebook", "", Context);
      Command.Print (Application, "auth.provider.facebook", "", Context);
      Command.Print (Application, "auth.url.google-plus", "", Context);
      Command.Print (Application, "auth.provider.google-plus", "", Context);
      Command.Print (Application, "facebook.callback_url", "", Context);
      Command.Print (Application, "facebook.request_url", "", Context);
      Command.Print (Application, "facebook.scope", "", Context);
      Command.Print (Application, "facebook.client_id", "", Context);
      Command.Print (Application, "facebook.secret", "", Context);
      Command.Print (Application, "google-plus.issuer", "", Context);
      Command.Print (Application, "google-plus.callback_url", "", Context);
      Command.Print (Application, "google-plus.request_url", "", Context);
      Command.Print (Application, "google-plus.scope", "", Context);
      Command.Print (Application, "google-plus.client_id", "", Context);
      Command.Print (Application, "google-plus.secret", "", Context);
      Command.Print (Application, "auth-filter.redirect", "", Context);
      Command.Print (Application, "verify-filter.redirect", "", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Mail Module");
      Context.Console.Notice (N_INFO, "-----------");
      Command.Print (Application, "mail.smtp.host", "", Context);
      Command.Print (Application, "mail.smtp.port", "", Context);
      Command.Print (Application, "mail.smtp.enable", "true", Context);
      Command.Print (Application, "mail.mailer", "smtp", Context);
      Command.Print (Application, "mail.file.maildir", "mail", Context);
      Command.Print (Application, "app_mail_name", "", Context);
      Command.Print (Application, "app_mail_from", "", Context);

      Module := Application.Find_Module ("workspaces");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Workspace Module");
         Context.Console.Notice (N_INFO, "----------------");
         Command.Print (Module.all, "permissions_list", "", Context);
         Command.Print (Module.all, "allow_workspace_create", "", Context);
      end if;

      Module := Application.Find_Module ("storages");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Storage Module");
         Context.Console.Notice (N_INFO, "--------------------------");
         Command.Print (Module.all, "database_max_size", "100000", Context);
         Command.Print (Module.all, "storage_root", "storage", Context);
         Command.Print (Module.all, "tmp_storage_root", "tmp", Context);
         Module := Application.Find_Module ("images");
         if Module /= null then
            Command.Print (Module.all, "thumbnail_command", "", Context);
         end if;
      end if;

      Module := Application.Find_Module ("wikis");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Wiki Module");
         Context.Console.Notice (N_INFO, "-----------");
         Command.Print (Module.all, "image_prefix", "", Context);
         Command.Print (Module.all, "page_prefix", "", Context);
         Command.Print (Module.all, "wiki_copy_list", "", Context);
         Module := Application.Find_Module ("wiki_previews");
         if Module /= null then
            Command.Print (Module.all, "wiki_preview_tmp", "tmp", Context);
            Command.Print (Module.all, "wiki_preview_dir", "web/preview", Context);
            Command.Print (Module.all, "wiki_preview_template", "", Context);
            Command.Print (Module.all, "wiki_preview_html", "", Context);
            Command.Print (Module.all, "wiki_preview_command", "", Context);
         end if;
      end if;

      Module := Application.Find_Module ("counters");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Counter Module");
         Context.Console.Notice (N_INFO, "--------------");
         Command.Print (Module.all, "counter_age_limit", "300", Context);
         Command.Print (Module.all, "counter_limit", "1000", Context);
      end if;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Set_Usage (Config => Config,
                    Usage  => Command.Get_Name & " [arguments]",
                    Help   => Command.Get_Description);
      Command_Drivers.Application_Command_Type (Command).Setup (Config, Context);
      GC.Define_Switch (Config => Config,
                        Output => Command.Long_List'Access,
                        Switch => "-l",
                        Long_Switch => "--long-lines",
                        Help   => -("Use long lines to print configuration values"));
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in out Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type) is
      pragma Unreferenced (Command, Context);
   begin
      null;
   end Help;

begin
   Command_Drivers.Driver.Add_Command ("info",
                                       -("report configuration information"),
                                       Command'Access);
end AWA.Commands.Info;

-----------------------------------------------------------------------
--  akt-commands-info -- Info command to describe the current configuration
--  Copyright (C) 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.
-----------------------------------------------------------------------
package body AWA.Commands.Info is

   use type AWA.Modules.Module_Access;

   --  ------------------------------
   --  Print the configuration identified by the given name.
   --  ------------------------------
   procedure Print (Command     : in out Command_Type;
                    Name        : in String;
                    Value       : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      pragma Unreferenced (Default);

      Pos   : Natural;
   begin
      Context.Console.Start_Row;
      Context.Console.Print_Field (1, Name);
      Pos := Value'First;
      while Pos <= Value'Last loop
         if Value'Last - Pos > Command.Value_Length then
            Context.Console.Print_Field (2, Value (Pos .. Pos + Command.Value_Length - 1));
            Pos := Pos + Command.Value_Length;
            Context.Console.End_Row;
            Context.Console.Start_Row;
            Context.Console.Print_Field (1, "");
         else
            Context.Console.Print_Field (2, Value (Pos .. Value'Last));
            Pos := Pos + Value'Length;
         end if;
      end loop;
      Context.Console.End_Row;
   end Print;

   procedure Print (Command     : in out Command_Type;
                    Application : in out AWA.Applications.Application'Class;
                    Name        : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      Value : constant String := Application.Get_Init_Parameter (Name, Default);
   begin
      Command.Print (Name, Value, Default, Context);
   end Print;

   procedure Print (Command     : in out Command_Type;
                    Module      : in AWA.Modules.Module'Class;
                    Name        : in String;
                    Default     : in String;
                    Context     : in out Context_Type) is
      Value : constant String := Module.Get_Config (Name, Default);
   begin
      Command.Print (Module.Get_Name & "." & Name, Value, Default, Context);
   end Print;

   --  ------------------------------
   --  Print the configuration about the application.
   --  ------------------------------
   overriding
   procedure Execute (Command     : in out Command_Type;
                      Application : in out AWA.Applications.Application'Class;
                      Args        : in Argument_List'Class;
                      Context     : in out Context_Type) is
      pragma Unreferenced (Args);

      Module : AWA.Modules.Module_Access;
   begin
      if Command.Long_List then
         Command.Value_Length := Natural'Last;
      end if;
      Application.Load_Bundle (Name   => "commands",
                               Locale => "en",
                               Bundle => Command.Bundle);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Database configuration");
      Context.Console.Notice (N_INFO, "----------------------");

      Command.Print (Application, "database", "", Context);
      Command.Print (Application, "ado.queries.paths", "", Context);
      Command.Print (Application, "ado.queries.load", "", Context);
      Command.Print (Application, "ado.drivers.load", "", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Server faces configuration");
      Context.Console.Notice (N_INFO, "--------------------------");

      Command.Print (Application, "view.dir",
                     ASF.Applications.DEF_VIEW_DIR, Context);
      Command.Print (Application, "view.escape_unknown_tags",
                     ASF.Applications.DEF_ESCAPE_UNKNOWN_TAGS, Context);
      Command.Print (Application, "view.ext",
                     ASF.Applications.DEF_VIEW_EXT, Context);
      Command.Print (Application, "view.file_ext",
                     ASF.Applications.DEF_VIEW_FILE_EXT, Context);
      Command.Print (Application, "view.ignore_spaces",
                     ASF.Applications.DEF_IGNORE_WHITE_SPACES, Context);
      Command.Print (Application, "view.ignore_empty_lines",
                     ASF.Applications.DEF_IGNORE_EMPTY_LINES, Context);
      Command.Print (Application, "view.static.dir",
                     ASF.Applications.DEF_STATIC_DIR, Context);
      Command.Print (Application, "bundle.dir", "bundles", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "AWA Application");
      Context.Console.Notice (N_INFO, "--------------------------");
      Command.Print (Application, "app_name", "", Context);
      Command.Print (Application, "app_search_dirs", ".", Context);
      Command.Print (Application, "app.modules.dir", "", Context);
      Command.Print (Application, "app_url_base", "", Context);
      Command.Print (Application, "awa_url_host", "", Context);
      Command.Print (Application, "awa_url_port", "", Context);
      Command.Print (Application, "awa_url_scheme", "", Context);
      Command.Print (Application, "app.config", "awa.xml", Context);
      Command.Print (Application, "app.config.plugins", "", Context);
      Command.Print (Application, "contextPath", "", Context);
      Command.Print (Application, "awa_dispatcher_count", "", Context);
      Command.Print (Application, "awa_dispatcher_priority", "", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Users Module");
      Context.Console.Notice (N_INFO, "------------");
      Command.Print (Application, "openid.realm", "", Context);
      Command.Print (Application, "openid.callback_url", "", Context);
      Command.Print (Application, "openid.success_url", "", Context);
      Command.Print (Application, "auth.url.orange", "", Context);
      Command.Print (Application, "auth.provider.orange", "", Context);
      Command.Print (Application, "auth.url.yahoo", "", Context);
      Command.Print (Application, "auth.provider.yahoo", "", Context);
      Command.Print (Application, "auth.url.google", "", Context);
      Command.Print (Application, "auth.provider.google", "", Context);
      Command.Print (Application, "auth.url.facebook", "", Context);
      Command.Print (Application, "auth.provider.facebook", "", Context);
      Command.Print (Application, "auth.url.google-plus", "", Context);
      Command.Print (Application, "auth.provider.google-plus", "", Context);
      Command.Print (Application, "facebook.callback_url", "", Context);
      Command.Print (Application, "facebook.request_url", "", Context);
      Command.Print (Application, "facebook.scope", "", Context);
      Command.Print (Application, "facebook.client_id", "", Context);
      Command.Print (Application, "facebook.secret", "", Context);
      Command.Print (Application, "google-plus.issuer", "", Context);
      Command.Print (Application, "google-plus.callback_url", "", Context);
      Command.Print (Application, "google-plus.request_url", "", Context);
      Command.Print (Application, "google-plus.scope", "", Context);
      Command.Print (Application, "google-plus.client_id", "", Context);
      Command.Print (Application, "google-plus.secret", "", Context);
      Command.Print (Application, "auth-filter.redirect", "", Context);
      Command.Print (Application, "verify-filter.redirect", "", Context);

      Context.Console.Start_Title;
      Context.Console.Print_Title (1, "", 30);
      Context.Console.Print_Title (2, "", Command.Value_Length);
      Context.Console.End_Title;
      Context.Console.Notice (N_INFO, "Mail Module");
      Context.Console.Notice (N_INFO, "-----------");
      Command.Print (Application, "mail.smtp.host", "", Context);
      Command.Print (Application, "mail.smtp.port", "", Context);
      Command.Print (Application, "mail.smtp.enable", "true", Context);
      Command.Print (Application, "mail.mailer", "smtp", Context);
      Command.Print (Application, "mail.file.maildir", "mail", Context);
      Command.Print (Application, "app_mail_name", "", Context);
      Command.Print (Application, "app_mail_from", "", Context);

      Module := Application.Find_Module ("workspaces");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Workspace Module");
         Context.Console.Notice (N_INFO, "----------------");
         Command.Print (Module.all, "permissions_list", "", Context);
         Command.Print (Module.all, "allow_workspace_create", "", Context);
      end if;

      Module := Application.Find_Module ("storages");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Storage Module");
         Context.Console.Notice (N_INFO, "--------------------------");
         Command.Print (Module.all, "database_max_size", "100000", Context);
         Command.Print (Module.all, "storage_root", "storage", Context);
         Command.Print (Module.all, "tmp_storage_root", "tmp", Context);
         Module := Application.Find_Module ("images");
         if Module /= null then
            Command.Print (Module.all, "thumbnail_command", "", Context);
         end if;
      end if;

      Module := Application.Find_Module ("wikis");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Wiki Module");
         Context.Console.Notice (N_INFO, "-----------");
         Command.Print (Module.all, "image_prefix", "", Context);
         Command.Print (Module.all, "page_prefix", "", Context);
         Command.Print (Module.all, "wiki_copy_list", "", Context);
         Module := Application.Find_Module ("wiki_previews");
         if Module /= null then
            Command.Print (Module.all, "wiki_preview_tmp", "tmp", Context);
            Command.Print (Module.all, "wiki_preview_dir", "web/preview", Context);
            Command.Print (Module.all, "wiki_preview_template", "", Context);
            Command.Print (Module.all, "wiki_preview_html", "", Context);
            Command.Print (Module.all, "wiki_preview_command", "", Context);
         end if;
      end if;

      Module := Application.Find_Module ("counters");
      if Module /= null then
         Context.Console.Start_Title;
         Context.Console.Print_Title (1, "", 30);
         Context.Console.Print_Title (2, "", Command.Value_Length);
         Context.Console.End_Title;
         Context.Console.Notice (N_INFO, "Counter Module");
         Context.Console.Notice (N_INFO, "--------------");
         Command.Print (Module.all, "counter_age_limit", "300", Context);
         Command.Print (Module.all, "counter_limit", "1000", Context);
      end if;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Set_Usage (Config => Config,
                    Usage  => Command.Get_Name & " [arguments]",
                    Help   => Command.Get_Description);
      Command_Drivers.Application_Command_Type (Command).Setup (Config, Context);
      GC.Define_Switch (Config => Config,
                        Output => Command.Long_List'Access,
                        Switch => "-l",
                        Long_Switch => "--long-lines",
                        Help   => -("Use long lines to print configuration values"));
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in out Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type) is
      pragma Unreferenced (Command, Context);
   begin
      null;
   end Help;

begin
   Command_Drivers.Driver.Add_Command ("info",
                                       -("report configuration information"),
                                       Command'Access);
end AWA.Commands.Info;

Fix list of configuration parameters

Fix list of configuration parameters


-----------------------------------------------------------------------
--  html -- ASF HTML Components
--  Copyright (C) 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.Exceptions;

with EL.Objects;

with ASF.Components.Core;
with ASF.Utils;
package body ASF.Components.Html.Text is

   use EL.Objects;

   TEXT_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   LABEL_ATTRIBUTE_NAMES : Util.Strings.String_Set.Set;

   --  ------------------------------
   --  Get the local value of the component without evaluating
   --  the associated Value_Expression.
   --  ------------------------------
   overriding
   function Get_Local_Value (UI : in UIOutput) return EL.Objects.Object is
   begin
      return UI.Value;
   end Get_Local_Value;

   --  ------------------------------
   --  Get the value to write on the output.
   --  ------------------------------
   overriding
   function Get_Value (UI    : in UIOutput) return EL.Objects.Object is
   begin
      if not EL.Objects.Is_Null (UI.Value) then
         return UI.Value;
      else
         return UI.Get_Attribute (UI.Get_Context.all, "value");
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value to write on the output.
   --  ------------------------------
   overriding
   procedure Set_Value (UI    : in out UIOutput;
                        Value : in EL.Objects.Object) is
   begin
      UI.Value := Value;
   end Set_Value;

   --  ------------------------------
   --  Get the converter that is registered on the component.
   --  ------------------------------
   overriding
   function Get_Converter (UI : in UIOutput)
                           return ASF.Converters.Converter_Access is
   begin
      return UI.Converter;
   end Get_Converter;

   --  ------------------------------
   --  Set the converter to be used on the component.
   --  ------------------------------
   overriding
   procedure Set_Converter (UI        : in out UIOutput;
                            Converter : in ASF.Converters.Converter_Access) is
      use type ASF.Converters.Converter_Access;
   begin
      if Converter = null then
         UI.Converter := null;
      else
         UI.Converter := Converter.all'Unchecked_Access;
      end if;
   end Set_Converter;

   --  ------------------------------
   --  Get the value of the component and apply the converter on it if there is one.
   --  ------------------------------
   function Get_Formatted_Value (UI      : in UIOutput;
                                 Context : in Faces_Context'Class) return String is
      Value : constant EL.Objects.Object := UIOutput'Class (UI).Get_Value;
   begin
      return UIOutput'Class (UI).Get_Formatted_Value (Value, Context);
   end Get_Formatted_Value;

   --  ------------------------------
   --  Format the value by appling the To_String converter on it if there is one.
   --  ------------------------------
   function Get_Formatted_Value (UI      : in UIOutput;
                                 Value   : in Util.Beans.Objects.Object;
                                 Context : in Contexts.Faces.Faces_Context'Class) return String is
      use type ASF.Converters.Converter_Access;
   begin
      if UI.Converter /= null then
         return UI.Converter.To_String (Context   => Context,
                                        Component => UI,
                                        Value     => Value);
      else
         declare
            Converter : constant access ASF.Converters.Converter'Class
              := UI.Get_Converter (Context);
         begin
            if Converter /= null then
               return Converter.To_String (Context   => Context,
                                           Component => UI,
                                           Value     => Value);
            elsif not Is_Null (Value) then
               return EL.Objects.To_String (Value);

            else
               return "";
            end if;
         end;
      end if;

      --  If the converter raises an exception, report an error in the logs.
      --  At this stage, we know the value and we can report it in this log message.
      --  We must queue the exception in the context, so this is done later.
   exception
      when E : others =>
         UI.Log_Error ("Error when converting value '{0}': {1}: {2}",
                       Util.Beans.Objects.To_String (Value),
                       Ada.Exceptions.Exception_Name (E),
                       Ada.Exceptions.Exception_Message (E));
         raise;
   end Get_Formatted_Value;

   procedure Write_Output (UI      : in UIOutput;
                           Context : in out Faces_Context'Class;
                           Value   : in String) is
      Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
      Escape : constant Object := UI.Get_Attribute (Context, "escape");
   begin
      Writer.Start_Optional_Element ("span");
      UI.Render_Attributes (Context, TEXT_ATTRIBUTE_NAMES, Writer);
      if Is_Null (Escape) or To_Boolean (Escape) then
         Writer.Write_Text (Value);
      else
         Writer.Write_Raw (Value);
      end if;
      Writer.End_Optional_Element ("span");
   end Write_Output;

   procedure Encode_Begin (UI      : in UIOutput;
                           Context : in out Faces_Context'Class) is
   begin
      if UI.Is_Rendered (Context) then
         UI.Write_Output (Context => Context,
                          Value   => UIOutput'Class (UI).Get_Formatted_Value (Context));

      end if;

      --  Queue any block converter exception that could be raised.
   exception
      when E : others =>
         Context.Queue_Exception (E);
   end Encode_Begin;

   --  ------------------------------
   --  Label Component
   --  ------------------------------

   procedure Encode_Begin (UI      : in UIOutputLabel;
                           Context : in out Faces_Context'Class) is
      Writer : Response_Writer_Access;
   begin
      if UI.Is_Rendered (Context) then
         Writer := Context.Get_Response_Writer;
         Writer.Start_Element ("label");
         UI.Render_Attributes (Context, LABEL_ATTRIBUTE_NAMES, Writer);
         declare
            Value : Util.Beans.Objects.Object := UI.Get_Attribute (Name    => "for",
                                                                   Context => Context);
         begin
            if not Util.Beans.Objects.Is_Null (Value) then
               Writer.Write_Attribute ("for", Value);
            end if;

            Value := UIOutputLabel'Class (UI).Get_Value;
            if not Util.Beans.Objects.Is_Null (Value) then
               declare
                  S : constant String
                    := UIOutputLabel'Class (UI).Get_Formatted_Value (Value, Context);
               begin
                  if UI.Get_Attribute (Name => "escape", Context => Context, Default => True) then
                     Writer.Write_Text (S);
                  else
                     Writer.Write_Raw (S);
                  end if;
               end;
            end if;

            --  Queue and block any converter exception that could be raised.
         exception
            when E : others =>
               Context.Queue_Exception (E);
         end;
      end if;
   end Encode_Begin;

   procedure Encode_End (UI      : in UIOutputLabel;
                         Context : in out Faces_Context'Class) is
      Writer : Response_Writer_Access;
   begin
      if UI.Is_Rendered (Context) then
         Writer := Context.Get_Response_Writer;
         Writer.End_Element ("label");
      end if;
   end Encode_End;

   --  ------------------------------
   --  OutputFormat Component
   --  ------------------------------
   procedure Encode_Begin (UI      : in UIOutputFormat;
                           Context : in out Faces_Context'Class) is
      use ASF.Components.Core;
      use ASF.Utils;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      declare
         Params : constant UIParameter_Access_Array := Get_Parameters (UI);
         Values : ASF.Utils.Object_Array (Params'Range);
         Result : Ada.Strings.Unbounded.Unbounded_String;
         Fmt    : constant String := EL.Objects.To_String (UI.Get_Value);
      begin
         --  Get the values associated with the parameters.
         for I in Params'Range loop
            Values (I) := Params (I).Get_Value (Context);
         end loop;
         Formats.Format (Fmt, Values, Result);
         UI.Write_Output (Context => Context,
                          Value   => To_String (Result));
      end;
   end Encode_Begin;

begin
   Utils.Set_Text_Attributes (TEXT_ATTRIBUTE_NAMES);
   Utils.Set_Text_Attributes (LABEL_ATTRIBUTE_NAMES);
   Utils.Set_Interactive_Attributes (LABEL_ATTRIBUTE_NAMES);
end ASF.Components.Html.Text;

-----------------------------------------------------------------------
--  html -- ASF HTML Components
--  Copyright (C) 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.Exceptions;
with Ada.Unchecked_Deallocation;

with EL.Objects;

with ASF.Components.Core;
with ASF.Utils;
package body ASF.Components.Html.Text is

   use EL.Objects;

   TEXT_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   LABEL_ATTRIBUTE_NAMES : Util.Strings.String_Set.Set;

   --  ------------------------------
   --  Get the local value of the component without evaluating
   --  the associated Value_Expression.
   --  ------------------------------
   overriding
   function Get_Local_Value (UI : in UIOutput) return EL.Objects.Object is
   begin
      return UI.Value;
   end Get_Local_Value;

   --  ------------------------------
   --  Get the value to write on the output.
   --  ------------------------------
   overriding
   function Get_Value (UI    : in UIOutput) return EL.Objects.Object is
   begin
      if not EL.Objects.Is_Null (UI.Value) then
         return UI.Value;
      else
         return UI.Get_Attribute (UI.Get_Context.all, "value");
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value to write on the output.
   --  ------------------------------
   overriding
   procedure Set_Value (UI    : in out UIOutput;
                        Value : in EL.Objects.Object) is
   begin
      UI.Value := Value;
   end Set_Value;

   --  ------------------------------
   --  Get the converter that is registered on the component.
   --  ------------------------------
   overriding
   function Get_Converter (UI : in UIOutput)
                           return ASF.Converters.Converter_Access is
   begin
      return UI.Converter;
   end Get_Converter;

   --  ------------------------------
   --  Set the converter to be used on the component.
   --  ------------------------------
   overriding
   procedure Set_Converter (UI        : in out UIOutput;
                            Converter : in ASF.Converters.Converter_Access;
                            Release   : in Boolean := False) is
      use type ASF.Converters.Converter_Access;
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => ASF.Converters.Converter'Class,
                                        Name   => ASF.Converters.Converter_Access);
   begin
      if UI.Release_Converter then
         Free (UI.Converter);
      end if;
      if Converter = null then
         UI.Converter := null;
         UI.Release_Converter := False;
      else
         UI.Converter := Converter.all'Unchecked_Access;
         UI.Release_Converter := Release;
      end if;
   end Set_Converter;

   --  ------------------------------
   --  Get the value of the component and apply the converter on it if there is one.
   --  ------------------------------
   function Get_Formatted_Value (UI      : in UIOutput;
                                 Context : in Faces_Context'Class) return String is
      Value : constant EL.Objects.Object := UIOutput'Class (UI).Get_Value;
   begin
      return UIOutput'Class (UI).Get_Formatted_Value (Value, Context);
   end Get_Formatted_Value;

   --  ------------------------------
   --  Format the value by appling the To_String converter on it if there is one.
   --  ------------------------------
   function Get_Formatted_Value (UI      : in UIOutput;
                                 Value   : in Util.Beans.Objects.Object;
                                 Context : in Contexts.Faces.Faces_Context'Class) return String is
      use type ASF.Converters.Converter_Access;
   begin
      if UI.Converter /= null then
         return UI.Converter.To_String (Context   => Context,
                                        Component => UI,
                                        Value     => Value);
      else
         declare
            Converter : constant access ASF.Converters.Converter'Class
              := UI.Get_Converter (Context);
         begin
            if Converter /= null then
               return Converter.To_String (Context   => Context,
                                           Component => UI,
                                           Value     => Value);
            elsif not Is_Null (Value) then
               return EL.Objects.To_String (Value);

            else
               return "";
            end if;
         end;
      end if;

      --  If the converter raises an exception, report an error in the logs.
      --  At this stage, we know the value and we can report it in this log message.
      --  We must queue the exception in the context, so this is done later.
   exception
      when E : others =>
         UI.Log_Error ("Error when converting value '{0}': {1}: {2}",
                       Util.Beans.Objects.To_String (Value),
                       Ada.Exceptions.Exception_Name (E),
                       Ada.Exceptions.Exception_Message (E));
         raise;
   end Get_Formatted_Value;

   procedure Write_Output (UI      : in UIOutput;
                           Context : in out Faces_Context'Class;
                           Value   : in String) is
      Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
      Escape : constant Object := UI.Get_Attribute (Context, "escape");
   begin
      Writer.Start_Optional_Element ("span");
      UI.Render_Attributes (Context, TEXT_ATTRIBUTE_NAMES, Writer);
      if Is_Null (Escape) or To_Boolean (Escape) then
         Writer.Write_Text (Value);
      else
         Writer.Write_Raw (Value);
      end if;
      Writer.End_Optional_Element ("span");
   end Write_Output;

   procedure Encode_Begin (UI      : in UIOutput;
                           Context : in out Faces_Context'Class) is
   begin
      if UI.Is_Rendered (Context) then
         UI.Write_Output (Context => Context,
                          Value   => UIOutput'Class (UI).Get_Formatted_Value (Context));

      end if;

      --  Queue any block converter exception that could be raised.
   exception
      when E : others =>
         Context.Queue_Exception (E);
   end Encode_Begin;

   overriding
   procedure Finalize (UI : in out UIOutput) is
   begin
      UI.Set_Converter (null);
   end Finalize;

   --  ------------------------------
   --  Label Component
   --  ------------------------------

   procedure Encode_Begin (UI      : in UIOutputLabel;
                           Context : in out Faces_Context'Class) is
      Writer : Response_Writer_Access;
   begin
      if UI.Is_Rendered (Context) then
         Writer := Context.Get_Response_Writer;
         Writer.Start_Element ("label");
         UI.Render_Attributes (Context, LABEL_ATTRIBUTE_NAMES, Writer);
         declare
            Value : Util.Beans.Objects.Object := UI.Get_Attribute (Name    => "for",
                                                                   Context => Context);
         begin
            if not Util.Beans.Objects.Is_Null (Value) then
               Writer.Write_Attribute ("for", Value);
            end if;

            Value := UIOutputLabel'Class (UI).Get_Value;
            if not Util.Beans.Objects.Is_Null (Value) then
               declare
                  S : constant String
                    := UIOutputLabel'Class (UI).Get_Formatted_Value (Value, Context);
               begin
                  if UI.Get_Attribute (Name => "escape", Context => Context, Default => True) then
                     Writer.Write_Text (S);
                  else
                     Writer.Write_Raw (S);
                  end if;
               end;
            end if;

            --  Queue and block any converter exception that could be raised.
         exception
            when E : others =>
               Context.Queue_Exception (E);
         end;
      end if;
   end Encode_Begin;

   procedure Encode_End (UI      : in UIOutputLabel;
                         Context : in out Faces_Context'Class) is
      Writer : Response_Writer_Access;
   begin
      if UI.Is_Rendered (Context) then
         Writer := Context.Get_Response_Writer;
         Writer.End_Element ("label");
      end if;
   end Encode_End;

   --  ------------------------------
   --  OutputFormat Component
   --  ------------------------------
   procedure Encode_Begin (UI      : in UIOutputFormat;
                           Context : in out Faces_Context'Class) is
      use ASF.Components.Core;
      use ASF.Utils;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      declare
         Params : constant UIParameter_Access_Array := Get_Parameters (UI);
         Values : ASF.Utils.Object_Array (Params'Range);
         Result : Ada.Strings.Unbounded.Unbounded_String;
         Fmt    : constant String := EL.Objects.To_String (UI.Get_Value);
      begin
         --  Get the values associated with the parameters.
         for I in Params'Range loop
            Values (I) := Params (I).Get_Value (Context);
         end loop;
         Formats.Format (Fmt, Values, Result);
         UI.Write_Output (Context => Context,
                          Value   => To_String (Result));
      end;
   end Encode_Begin;

begin
   Utils.Set_Text_Attributes (TEXT_ATTRIBUTE_NAMES);
   Utils.Set_Text_Attributes (LABEL_ATTRIBUTE_NAMES);
   Utils.Set_Interactive_Attributes (LABEL_ATTRIBUTE_NAMES);
end ASF.Components.Html.Text;

Implement the Finalize procedure to release the converter if there was one Add a Release parameter to Set_Converter and release the previous converter if it was marked with release flag


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

with Ada.Containers.Vectors;
with Util.Strings.Sets;
package Gen.Commands.Templates is

   --  ------------------------------
   --  Template Generic Command
   --  ------------------------------
   --  This command adds a XHTML page to the web application.
   type Command is new Gen.Commands.Command with private;
   type Command_Access is access all Command'Class;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler);

   --  Write the help associated with the command.
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler);

   --  Read the template commands defined in dynamo configuration directory.
   procedure Read_Commands (Generator : in out Gen.Generator.Handler);

private

   type Param is record
      Name        : Ada.Strings.Unbounded.Unbounded_String;
      Argument    : Ada.Strings.Unbounded.Unbounded_String;
      Value       : Ada.Strings.Unbounded.Unbounded_String;
      Is_Optional : Boolean := False;
   end record;

   package Param_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Param);

   type Command is new Gen.Commands.Command with record
      Name      : Ada.Strings.Unbounded.Unbounded_String;
      Title     : Ada.Strings.Unbounded.Unbounded_String;
      Usage     : Ada.Strings.Unbounded.Unbounded_String;
      Help_Msg  : Ada.Strings.Unbounded.Unbounded_String;
      Base_Dir  : Ada.Strings.Unbounded.Unbounded_String;
      Templates : Util.Strings.Sets.Set;
      Params    : Param_Vectors.Vector;
   end record;

end Gen.Commands.Templates;

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

with Ada.Containers.Vectors;
with Util.Strings.Sets;
with Util.Strings.Vectors;
package Gen.Commands.Templates is

   --  ------------------------------
   --  Template Generic Command
   --  ------------------------------
   --  This command adds a XHTML page to the web application.
   type Command is new Gen.Commands.Command with private;
   type Command_Access is access all Command'Class;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler);

   --  Write the help associated with the command.
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler);

   --  Read the template commands defined in dynamo configuration directory.
   procedure Read_Commands (Generator : in out Gen.Generator.Handler);

private

   type Param is record
      Name        : Ada.Strings.Unbounded.Unbounded_String;
      Argument    : Ada.Strings.Unbounded.Unbounded_String;
      Value       : Ada.Strings.Unbounded.Unbounded_String;
      Is_Optional : Boolean := False;
   end record;

   package Param_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Param);

   type Patch is record
      Template  : Ada.Strings.Unbounded.Unbounded_String;
      After     : Util.Strings.Vectors.Vector;
      Before    : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   package Patch_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Patch);

   type Command is new Gen.Commands.Command with record
      Name      : Ada.Strings.Unbounded.Unbounded_String;
      Title     : Ada.Strings.Unbounded.Unbounded_String;
      Usage     : Ada.Strings.Unbounded.Unbounded_String;
      Help_Msg  : Ada.Strings.Unbounded.Unbounded_String;
      Base_Dir  : Ada.Strings.Unbounded.Unbounded_String;
      Templates : Util.Strings.Sets.Set;
      Patches   : Patch_Vectors.Vector;
      Params    : Param_Vectors.Vector;
   end record;

end Gen.Commands.Templates;

Add support to patch files when executing some template command


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

with Util.Test_Caller;

with MAT.Expressions;
with MAT.Memory.Targets;
package body MAT.Memory.Tests is

   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "Memory");

   --  Builtin and well known definition of test frames.
   Frame_1_0 : constant MAT.Frames.Frame_Table (1 .. 10) :=
     (1_0, 1_2, 1_3, 1_4, 1_5, 1_6, 1_7, 1_8, 1_9, 1_10);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test MAT.Memory.Probe_Malloc",
                       Test_Probe_Malloc'Access);
      Caller.Add_Test (Suite, "Test MAT.Memory.Probe_Free",
                       Test_Probe_Free'Access);
   end Add_Tests;

   --  ------------------------------
   --  Basic consistency checks when creating the test tree
   --  ------------------------------
   procedure Test_Probe_Malloc (T : in out Test) is
      M    : MAT.Memory.Targets.Target_Memory;
      S    : Allocation;
      R    : Allocation_Map;
   begin
      S.Size :=  4;
      M.Create_Frame (Frame_1_0, S.Frame);

      --  Create memory slots:
      --   [10 .. 14] [20 .. 24] [30 ..34] .. [100 .. 104]
      for I in 1 .. 10 loop
         M.Probe_Malloc (MAT.Types.Target_Addr (10 * I), S);
      end loop;

      --  Search for a memory region that does not overlap a memory slot.
      M.Find (15, 19, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 0, Integer (R.Length),
                                "Find must return 0 slots in range [15 .. 19]");
      M.Find (1, 9, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 0, Integer (R.Length),
                                "Find must return 0 slots in range [1 .. 9]");
      M.Find (105, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 0, Integer (R.Length),
                                "Find must return 0 slots in range [105 .. 1000]");

      --  Search with an overlap.
      M.Find (1, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 10, Integer (R.Length),
                                "Find must return 10 slots in range [1 .. 1000]");

      R.Clear;
      M.Find (1, 19, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 1, Integer (R.Length),
                                "Find must return 1 slot in range [1 .. 19]");

      R.Clear;
      M.Find (13, 19, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 1, Integer (R.Length),
                                "Find must return 1 slot in range [13 .. 19]");

      R.Clear;
      M.Find (100, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 1, Integer (R.Length),
                                "Find must return 1 slot in range [100 .. 1000]");

      R.Clear;
      M.Find (101, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 1, Integer (R.Length),
                                "Find must return 1 slot in range [101 .. 1000]");

   end Test_Probe_Malloc;

   --  ------------------------------
   --  Test Probe_Free with update of memory slots.
   --  ------------------------------
   procedure Test_Probe_Free (T : in out Test) is
      M    : MAT.Memory.Targets.Target_Memory;
      S    : Allocation;
      R    : Allocation_Map;
   begin
      S.Size :=  4;
      M.Create_Frame (Frame_1_0, S.Frame);

      --  Malloc followed by a free.
      M.Probe_Malloc (10, S);
      M.Probe_Free (10, S);

      M.Find (1, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 0, Integer (R.Length),
                                "Find must return 0 slot after a free");

      --  Free the same slot a second time (free error).
      M.Probe_Free (10, S);

      --  Malloc followed by a free.
      M.Probe_Malloc (10, S);
      M.Probe_Malloc (20, S);
      M.Probe_Malloc (30, S);
      M.Probe_Free (20, S);

      M.Find (1, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 2, Integer (R.Length),
                                "Find must return 2 slots after a malloc/free sequence");
   end Test_Probe_Free;

end MAT.Memory.Tests;

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

with Util.Test_Caller;

with MAT.Expressions;
with MAT.Memory.Targets;
package body MAT.Memory.Tests is

   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "Memory");

   --  Builtin and well known definition of test frames.
   Frame_1_0 : constant MAT.Frames.Frame_Table (1 .. 10) :=
     (1_0, 1_2, 1_3, 1_4, 1_5, 1_6, 1_7, 1_8, 1_9, 1_10);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test MAT.Memory.Probe_Malloc",
                       Test_Probe_Malloc'Access);
      Caller.Add_Test (Suite, "Test MAT.Memory.Probe_Free",
                       Test_Probe_Free'Access);
   end Add_Tests;

   --  ------------------------------
   --  Basic consistency checks when creating the test tree
   --  ------------------------------
   procedure Test_Probe_Malloc (T : in out Test) is
      M    : MAT.Memory.Targets.Target_Memory;
      S    : Allocation;
      R    : Allocation_Map;
   begin
      S.Size :=  4;
      M.Create_Frame (Frame_1_0, S.Frame);

      --  Create memory slots:
      --   [10 .. 14] [20 .. 24] [30 ..34] .. [100 .. 104]
      for I in 1 .. 10 loop
         M.Probe_Malloc (MAT.Types.Target_Addr (10 * I), S);
      end loop;

      --  Search for a memory region that does not overlap a memory slot.
      M.Find (15, 19, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 0, Integer (R.Length),
                                "Find must return 0 slots in range [15 .. 19]");
      M.Find (1, 9, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 0, Integer (R.Length),
                                "Find must return 0 slots in range [1 .. 9]");
      M.Find (105, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 0, Integer (R.Length),
                                "Find must return 0 slots in range [105 .. 1000]");

      --  Search with an overlap.
      M.Find (1, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 10, Integer (R.Length),
                                "Find must return 10 slots in range [1 .. 1000]");

      R.Clear;
      M.Find (1, 19, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 1, Integer (R.Length),
                                "Find must return 1 slot in range [1 .. 19]");

      R.Clear;
      M.Find (13, 19, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 1, Integer (R.Length),
                                "Find must return 1 slot in range [13 .. 19]");

      R.Clear;
      M.Find (100, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 1, Integer (R.Length),
                                "Find must return 1 slot in range [100 .. 1000]");

      R.Clear;
      M.Find (101, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 1, Integer (R.Length),
                                "Find must return 1 slot in range [101 .. 1000]");

   end Test_Probe_Malloc;

   --  ------------------------------
   --  Test Probe_Free with update of memory slots.
   --  ------------------------------
   procedure Test_Probe_Free (T : in out Test) is
      M    : MAT.Memory.Targets.Target_Memory;
      S    : Allocation;
      R    : Allocation_Map;
      Size : MAT.Types.Target_Size;
      Id   : MAT.Events.Targets.Event_Id_Type;
   begin
      S.Size :=  4;
      M.Create_Frame (Frame_1_0, S.Frame);

      --  Malloc followed by a free.
      M.Probe_Malloc (10, S);
      M.Probe_Free (10, S, Size, Id);

      M.Find (1, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 0, Integer (R.Length),
                                "Find must return 0 slot after a free");

      --  Free the same slot a second time (free error).
      M.Probe_Free (10, S, Size, Id);

      --  Malloc followed by a free.
      M.Probe_Malloc (10, S);
      M.Probe_Malloc (20, S);
      M.Probe_Malloc (30, S);
      M.Probe_Free (20, S, Size, Id);

      M.Find (1, 1000, MAT.Expressions.EMPTY, R);
      Util.Tests.Assert_Equals (T, 2, Integer (R.Length),
                                "Find must return 2 slots after a malloc/free sequence");
   end Test_Probe_Free;

end MAT.Memory.Tests;

Update the unit tests

Update the unit tests


-----------------------------------------------------------------------
--  html.lists -- List of items
--  Copyright (C) 2009, 2010, 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log.Loggers;
with Util.Beans.Basic;
with ASF.Components.Base;
package body ASF.Components.Html.Lists is

   use Util.Log;
   use type EL.Objects.Data_Type;

   Log : constant Loggers.Logger := Loggers.Create ("ASF.Components.Html.Lists");

   --  ------------------------------
   --  Get the value to write on the output.
   --  ------------------------------
   function Get_Value (UI : in UIList) return EL.Objects.Object is
   begin
      return UI.Get_Attribute (UI.Get_Context.all, "value");
   end Get_Value;

   --  ------------------------------
   --  Set the value to write on the output.
   --  ------------------------------
   procedure Set_Value (UI    : in out UIList;
                        Value : in EL.Objects.Object) is
   begin
      null;
   end Set_Value;

   --  ------------------------------
   --  Get the variable name
   --  ------------------------------
   function Get_Var (UI : in UIList) return String is
      Var : constant EL.Objects.Object := UI.Get_Attribute (UI.Get_Context.all, "var");
   begin
      return EL.Objects.To_String (Var);
   end Get_Var;

   procedure Encode_Children (UI      : in UIList;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      declare
         Value : EL.Objects.Object := Get_Value (UI);
         Kind  : constant EL.Objects.Data_Type := EL.Objects.Get_Type (Value);
         Name  : constant String := UI.Get_Var;
         Bean  : access Util.Beans.Basic.Readonly_Bean'Class;
         Is_Reverse : constant Boolean := UI.Get_Attribute ("reverse", Context, False);
         List  : Util.Beans.Basic.List_Bean_Access;
         Count : Natural;
      begin
         --  Check that we have a List_Bean but do not complain if we have a null value.
         if Kind /= EL.Objects.TYPE_BEAN then
            if Kind /= EL.Objects.TYPE_NULL then
               ASF.Components.Base.Log_Error (UI, "Invalid list bean (found a {0})",
                                              EL.Objects.Get_Type_Name (Value));
            end if;
            return;
         end if;

         Bean := EL.Objects.To_Bean (Value);
         if Bean = null or else not (Bean.all in Util.Beans.Basic.List_Bean'Class) then
            ASF.Components.Base.Log_Error (UI, "Invalid list bean: "
                                           & "it does not implement 'List_Bean' interface");
            return;
         end if;

         List := Util.Beans.Basic.List_Bean'Class (Bean.all)'Unchecked_Access;
         Count := List.Get_Count;
         if Is_Reverse then
            for I in reverse 1 .. Count loop
               List.Set_Row_Index (I);
               Value := List.Get_Row;

               Context.Set_Attribute (Name, Value);
               Log.Debug ("Set variable {0}", Name);
               Base.UIComponent (UI).Encode_Children (Context);
            end loop;
         else
            for I in 1 .. Count loop
               List.Set_Row_Index (I);
               Value := List.Get_Row;

               Context.Set_Attribute (Name, Value);
               Log.Debug ("Set variable {0}", Name);
               Base.UIComponent (UI).Encode_Children (Context);
            end loop;
         end if;
      end;
   end Encode_Children;

end ASF.Components.Html.Lists;

-----------------------------------------------------------------------
--  html.lists -- List of items
--  Copyright (C) 2009, 2010, 2013, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log.Loggers;
with Util.Beans.Basic;
with ASF.Components.Base;
package body ASF.Components.Html.Lists is

   use type EL.Objects.Data_Type;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Components.Html.Lists");

   function Get_Item_Layout (List_Layout : in String;
                             Item_Class  : in String) return String;

   --  ------------------------------
   --  Get the list layout to use.  The default is to use no layout or a div if some CSS style
   --  is applied on the list or some specific list ID must be generated.  Possible layout values
   --  include:
   --    "simple"        : the list is rendered as is or as a div with each children as is,
   --    "unorderedList" : the list is rendered as an HTML ul/li list,
   --    "orderedList"   : the list is rendered as an HTML ol/li list.
   --  ------------------------------
   function Get_Layout (UI      : in UIList;
                        Class   : in String;
                        Context : in Faces_Context'Class) return String is
      Value  : constant EL.Objects.Object := UI.Get_Attribute (Context, "layout");
      Layout : constant String := EL.Objects.To_String (Value);
   begin
      if Layout = "orderedList" or Layout = "ordered" then
         return "ol";
      elsif Layout = "unorderedList" or Layout = "unordered" then
         return "ul";
      elsif Class'Length > 0 or else not UI.Is_Generated_Id then
         return "div";
      else
         return "";
      end if;
   end Get_Layout;

   --  ------------------------------
   --  Get the item layout according to the list layout and the item class (if any).
   --  ------------------------------
   function Get_Item_Layout (List_Layout : in String;
                             Item_Class  : in String) return String is
   begin
      if List_Layout'Length = 2 then
         return "li";
      elsif Item_Class'Length > 0 then
         return "div";
      else
         return "";
      end if;
   end Get_Item_Layout;

   --  ------------------------------
   --  Get the value to write on the output.
   --  ------------------------------
   function Get_Value (UI : in UIList) return EL.Objects.Object is
   begin
      return UI.Get_Attribute (UI.Get_Context.all, "value");
   end Get_Value;

   --  ------------------------------
   --  Set the value to write on the output.
   --  ------------------------------
   procedure Set_Value (UI    : in out UIList;
                        Value : in EL.Objects.Object) is
   begin
      null;
   end Set_Value;

   --  ------------------------------
   --  Get the variable name
   --  ------------------------------
   function Get_Var (UI : in UIList) return String is
      Var : constant EL.Objects.Object := UI.Get_Attribute (UI.Get_Context.all, "var");
   begin
      return EL.Objects.To_String (Var);
   end Get_Var;

   --  ------------------------------
   --  Encode an item of the list with the given item layout and item class.
   --  ------------------------------
   procedure Encode_Item (UI          : in UIList;
                          Item_Layout : in String;
                          Item_Class  : in String;
                          Context     : in out Faces_Context'Class) is
      Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if Item_Layout'Length > 0 then
         Writer.Start_Element (Item_Layout);
      end if;
      if Item_Class'Length > 0 then
         Writer.Write_Attribute ("class", Item_Class);
      end if;
      Base.UIComponent (UI).Encode_Children (Context);
      if Item_Layout'Length > 0 then
         Writer.End_Element (Item_Layout);
      end if;
   end Encode_Item;

   procedure Encode_Children (UI      : in UIList;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      declare
         Value      : EL.Objects.Object := Get_Value (UI);
         Kind       : constant EL.Objects.Data_Type := EL.Objects.Get_Type (Value);
         Name       : constant String := UI.Get_Var;
         Bean       : access Util.Beans.Basic.Readonly_Bean'Class;
         Is_Reverse : constant Boolean := UI.Get_Attribute ("reverse", Context, False);
         List       : Util.Beans.Basic.List_Bean_Access;
         Count      : Natural;
      begin
         --  Check that we have a List_Bean but do not complain if we have a null value.
         if Kind /= EL.Objects.TYPE_BEAN then
            if Kind /= EL.Objects.TYPE_NULL then
               ASF.Components.Base.Log_Error (UI, "Invalid list bean (found a {0})",
                                              EL.Objects.Get_Type_Name (Value));
            end if;
            return;
         end if;

         Bean := EL.Objects.To_Bean (Value);
         if Bean = null or else not (Bean.all in Util.Beans.Basic.List_Bean'Class) then
            ASF.Components.Base.Log_Error (UI, "Invalid list bean: "
                                           & "it does not implement 'List_Bean' interface");
            return;
         end if;

         List := Util.Beans.Basic.List_Bean'Class (Bean.all)'Unchecked_Access;
         Count := List.Get_Count;
         if Count /= 0 then
            declare
               Class       : constant String := UI.Get_Attribute (STYLE_CLASS_ATTR_NAME,
                                                                  Context, "");
               Item_Class  : constant String := UI.Get_Attribute (ITEM_STYLE_CLASS_ATTR_NAME,
                                                                  Context, "");
               Layout      : constant String := UI.Get_Layout (Class, Context);
               Writer      : constant Response_Writer_Access := Context.Get_Response_Writer;
               Item_Layout : constant String := Get_Item_Layout (Layout, Item_Class);
            begin
               if Layout'Length > 0 then
                  Writer.Start_Element (Layout);
               end if;
               if not UI.Is_Generated_Id then
                  Writer.Write_Attribute ("id", UI.Get_Client_Id);
               end if;
               if Class'Length > 0 then
                  Writer.Write_Attribute ("class", Class);
               end if;
               if Is_Reverse then
                  for I in reverse 1 .. Count loop
                     List.Set_Row_Index (I);
                     Value := List.Get_Row;

                     Context.Set_Attribute (Name, Value);
                     Log.Debug ("Set variable {0}", Name);
                     UI.Encode_Item (Item_Layout, Item_Class, Context);
                  end loop;
               else
                  for I in 1 .. Count loop
                     List.Set_Row_Index (I);
                     Value := List.Get_Row;

                     Context.Set_Attribute (Name, Value);
                     Log.Debug ("Set variable {0}", Name);
                     UI.Encode_Item (Item_Layout, Item_Class, Context);
                  end loop;
               end if;
               if Layout'Length > 0 then
                  Writer.End_Element (Layout);
               end if;
            end;
         end if;
      end;
   end Encode_Children;

end ASF.Components.Html.Lists;

Add support to render ordered and unordered lists - Implement Get_Layout and Encode_Item - Allow to render a CSS class on the list as well as on each list item


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

with Util.Commands.Drivers;
with Util.Properties;
with Util.Commands;
with Druss.Gateways;
package Druss.Commands.Bboxes is

   type Command_Type is new Druss.Commands.Drivers.Command_Type with null record;

   --  Execute the command with the arguments.  The command name is passed with the command
   --  arguments.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Util.Commands.Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type);

end Druss.Commands.Bboxes;

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

package Druss.Commands.Bboxes is

   type Command_Type is new Druss.Commands.Drivers.Command_Type with null record;

   procedure Discover (Command   : in Command_Type);

   --  Execute the command with the arguments.  The command name is passed with the command
   --  arguments.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Druss.Commands.Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type);

end Druss.Commands.Bboxes;

Declare the Discover procedure

Declare the Discover procedure