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

with Ada.Text_IO;
with Ada.Directories;

with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Filters.Autolink;
with Wiki.Filters.Variables;
with Wiki.Plugins.Templates;
with Wiki.Plugins.Conditions;
with Wiki.Plugins.Variables;
with Wiki.Streams.Text_IO;
with Wiki.Streams.Html.Text_IO;
with Wiki.Documents;
with Wiki.Parsers;
package body Wiki.Tests is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is

      use Ada.Directories;

      Result_File : constant String := To_String (T.Result);
      Dir         : constant String := Containing_Directory (Result_File);
      Doc         : Wiki.Documents.Document;
      Engine      : Wiki.Parsers.Parser;
      Toc_Filter  : aliased Wiki.Filters.TOC.TOC_Filter;
      Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
      Var_Filter  : aliased Wiki.Filters.Variables.Variable_Filter;
      Auto_Filter : aliased Wiki.Filters.Autolink.Autolink_Filter;
      Template    : aliased Wiki.Plugins.Templates.File_Template_Plugin;
      Condition   : aliased Wiki.Plugins.Conditions.Condition_Plugin;
      Variables   : aliased Wiki.Plugins.Variables.Variable_Plugin;
      Input       : aliased Wiki.Streams.Text_IO.File_Input_Stream;
      Output      : aliased Wiki.Streams.Html.Text_IO.Html_File_Output_Stream;

      type Test_Factory is new Wiki.Plugins.Plugin_Factory with null record;

      --  Find a plugin knowing its name.
      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access;

      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access is
         pragma Unreferenced (Factory);
      begin
         if Name = "if" or Name = "else" or Name = "elsif" or Name = "end" then
            return Condition'Unchecked_Access;
         elsif Name = "set" then
            return Variables'Unchecked_Access;
         else
            return Template.Find (Name);
         end if;
      end Find;

      Local_Factory : aliased Test_Factory;
   begin
      if not Exists (Dir) then
         Create_Path (Dir);
      end if;
      Input.Open (Path => To_String (T.File),
                  Form => "WCEM=8");
      Output.Create (Result_File, "WCEM=8");
      Template.Set_Template_Path (Containing_Directory (To_String (T.File)));
      Condition.Append ("public", "");
      Condition.Append ("user", "admin");
      declare
         Time : Util.Measures.Stamp;
      begin
         Engine.Set_Syntax (T.Source);
         Engine.Set_Plugin_Factory (Local_Factory'Unchecked_Access);
         Engine.Add_Filter (Toc_Filter'Unchecked_Access);
         Engine.Add_Filter (Auto_Filter'Unchecked_Access);
         Engine.Add_Filter (Html_Filter'Unchecked_Access);
         Engine.Add_Filter (Var_Filter'Unchecked_Access);
         Engine.Parse (Input'Unchecked_Access, Doc);
         Util.Measures.Report (Time, "Parse " & To_String (T.Name));
         if T.Source = Wiki.SYNTAX_HTML then
            declare
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access, T.Format);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Wiki " & To_String (T.Name));
            end;
         elsif T.Is_Html then
            declare
               Renderer : aliased Wiki.Render.Html.Html_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Set_Render_TOC (True);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render HTML " & To_String (T.Name));
            end;
         else
            declare
               Renderer : aliased Wiki.Render.Text.Text_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Text " & To_String (T.Name));
            end;
         end if;
      end;
      Input.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Render;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Wiki_Syntax;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.SYNTAX_MEDIA_WIKI;
                  elsif Ext = "markdown" then
                     Format := Wiki.SYNTAX_MARKDOWN;
                  else
                     Format := Wiki.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Wiki_Syntax'Range loop
                     case Syntax is
                        when Wiki.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
   end Add_Tests;

end Wiki.Tests;

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

with Ada.Text_IO;
with Ada.Directories;

with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Filters.Autolink;
with Wiki.Filters.Variables;
with Wiki.Plugins.Templates;
with Wiki.Plugins.Conditions;
with Wiki.Plugins.Variables;
with Wiki.Streams.Text_IO;
with Wiki.Streams.Html.Text_IO;
with Wiki.Documents;
with Wiki.Parsers;
package body Wiki.Tests is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is

      use Ada.Directories;

      Result_File : constant String := To_String (T.Result);
      Dir         : constant String := Containing_Directory (Result_File);
      Doc         : Wiki.Documents.Document;
      Engine      : Wiki.Parsers.Parser;
      Toc_Filter  : aliased Wiki.Filters.TOC.TOC_Filter;
      Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
      Var_Filter  : aliased Wiki.Filters.Variables.Variable_Filter;
      Auto_Filter : aliased Wiki.Filters.Autolink.Autolink_Filter;
      Template    : aliased Wiki.Plugins.Templates.File_Template_Plugin;
      Condition   : aliased Wiki.Plugins.Conditions.Condition_Plugin;
      Variables   : aliased Wiki.Plugins.Variables.Variable_Plugin;
      List_Vars   : aliased Wiki.Plugins.Variables.List_Variable_Plugin;
      Input       : aliased Wiki.Streams.Text_IO.File_Input_Stream;
      Output      : aliased Wiki.Streams.Html.Text_IO.Html_File_Output_Stream;

      type Test_Factory is new Wiki.Plugins.Plugin_Factory with null record;

      --  Find a plugin knowing its name.
      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access;

      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access is
         pragma Unreferenced (Factory);
      begin
         if Name = "if" or Name = "else" or Name = "elsif" or Name = "end" then
            return Condition'Unchecked_Access;
         elsif Name = "set" then
            return Variables'Unchecked_Access;
         elsif Name = "list" then
            return List_Vars'Unchecked_Access;
         else
            return Template.Find (Name);
         end if;
      end Find;

      Local_Factory : aliased Test_Factory;
   begin
      if not Exists (Dir) then
         Create_Path (Dir);
      end if;
      Input.Open (Path => To_String (T.File),
                  Form => "WCEM=8");
      Output.Create (Result_File, "WCEM=8");
      Template.Set_Template_Path (Containing_Directory (To_String (T.File)));
      Condition.Append ("public", "");
      Condition.Append ("user", "admin");
      declare
         Time : Util.Measures.Stamp;
      begin
         Engine.Set_Syntax (T.Source);
         Engine.Set_Plugin_Factory (Local_Factory'Unchecked_Access);
         Engine.Add_Filter (Toc_Filter'Unchecked_Access);
         Engine.Add_Filter (Auto_Filter'Unchecked_Access);
         Engine.Add_Filter (Html_Filter'Unchecked_Access);
         Engine.Add_Filter (Var_Filter'Unchecked_Access);
         Engine.Parse (Input'Unchecked_Access, Doc);
         Util.Measures.Report (Time, "Parse " & To_String (T.Name));
         if T.Source = Wiki.SYNTAX_HTML then
            declare
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access, T.Format);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Wiki " & To_String (T.Name));
            end;
         elsif T.Is_Html then
            declare
               Renderer : aliased Wiki.Render.Html.Html_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Set_Render_TOC (True);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render HTML " & To_String (T.Name));
            end;
         else
            declare
               Renderer : aliased Wiki.Render.Text.Text_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Text " & To_String (T.Name));
            end;
         end if;
      end;
      Input.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Render;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Wiki_Syntax;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.SYNTAX_MEDIA_WIKI;
                  elsif Ext = "markdown" then
                     Format := Wiki.SYNTAX_MARKDOWN;
                  else
                     Format := Wiki.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Wiki_Syntax'Range loop
                     case Syntax is
                        when Wiki.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
   end Add_Tests;

end Wiki.Tests;

Declare the List_Variable_Plugin and allow to retrieve it with the plugin factory


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

with Ada.Text_IO;
with Ada.Directories;
with Ada.Characters.Conversions;

with Util.Files;
with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Filters.Html;
with Wiki.Streams.Html.Builders;
with Wiki.Streams.Builders;
with Wiki.Utils;
with Wiki.Nodes;
with Wiki.Parsers;
package body Wiki.Tests is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is
      function To_Wide (Item : in String) return Wide_Wide_String
        renames Ada.Characters.Conversions.To_Wide_Wide_String;

      Result_File : constant String := To_String (T.Result);
      Content     : Unbounded_String;
   begin
      Util.Files.Read_File (Path     => To_String (T.File),
                            Into     => Content,
                            Max_Size => 10000);
      declare
         Time : Util.Measures.Stamp;
      begin
         if T.Source = Wiki.SYNTAX_HTML then
            declare
               Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
               Writer      : aliased Wiki.Streams.Builders.Output_Builder_Stream;
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
               Doc         : Wiki.Nodes.Document;
               Engine      : Wiki.Parsers.Parser;
            begin
               Renderer.Set_Output_Stream (Writer'Unchecked_Access, T.Format);
               Engine.Add_Filter (Html_Filter'Unchecked_Access);
               Engine.Set_Syntax (Wiki.SYNTAX_HTML);
               Engine.Parse (To_Wide (To_String (Content)), Doc);
               Renderer.Render (Doc);
               Content := To_Unbounded_String (Writer.To_String);
            end;
         elsif T.Is_Html then
            Content := To_Unbounded_String
              (Utils.To_Html (To_Wide (To_String (Content)), T.Format));
         else
            Content := To_Unbounded_String
              (Utils.To_Text (To_Wide (To_String (Content)), T.Format));
         end if;

         Util.Measures.Report (Time, "Render " & To_String (T.Name));
      end;

      Util.Files.Write_File (Result_File, Content);
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Render;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Wiki_Syntax;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.SYNTAX_MEDIA_WIKI;
                  else
                     Format := Wiki.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Wiki_Syntax'Range loop
                     case Syntax is
                        when Wiki.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
   end Add_Tests;

end Wiki.Tests;

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

with Ada.Text_IO;
with Ada.Directories;
with Ada.Characters.Conversions;

with Util.Files;
with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Filters.Html;
with Wiki.Streams.Html.Builders;
with Wiki.Streams.Builders;
with Wiki.Utils;
with Wiki.Documents;
with Wiki.Parsers;
package body Wiki.Tests is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is
      function To_Wide (Item : in String) return Wide_Wide_String
        renames Ada.Characters.Conversions.To_Wide_Wide_String;

      Result_File : constant String := To_String (T.Result);
      Content     : Unbounded_String;
   begin
      Util.Files.Read_File (Path     => To_String (T.File),
                            Into     => Content,
                            Max_Size => 10000);
      declare
         Time : Util.Measures.Stamp;
      begin
         if T.Source = Wiki.SYNTAX_HTML then
            declare
               Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
               Writer      : aliased Wiki.Streams.Builders.Output_Builder_Stream;
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
               Doc         : Wiki.Documents.Document;
               Engine      : Wiki.Parsers.Parser;
            begin
               Renderer.Set_Output_Stream (Writer'Unchecked_Access, T.Format);
               Engine.Add_Filter (Html_Filter'Unchecked_Access);
               Engine.Set_Syntax (Wiki.SYNTAX_HTML);
               Engine.Parse (To_Wide (To_String (Content)), Doc);
               Renderer.Render (Doc);
               Content := To_Unbounded_String (Writer.To_String);
            end;
         elsif T.Is_Html then
            Content := To_Unbounded_String
              (Utils.To_Html (To_Wide (To_String (Content)), T.Format));
         else
            Content := To_Unbounded_String
              (Utils.To_Text (To_Wide (To_String (Content)), T.Format));
         end if;

         Util.Measures.Report (Time, "Render " & To_String (T.Name));
      end;

      Util.Files.Write_File (Result_File, Content);
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Render;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Wiki_Syntax;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.SYNTAX_MEDIA_WIKI;
                  else
                     Format := Wiki.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Wiki_Syntax'Range loop
                     case Syntax is
                        when Wiki.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
   end Add_Tests;

end Wiki.Tests;

Use Wiki.Documents.Document type

Use Wiki.Documents.Document type


-----------------------------------------------------------------------
--  Memory clients - Client info related to its 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 MAT.Frames;
with MAT.Readers;
with MAT.Memory.Tools;
with MAT.Expressions;
package MAT.Memory.Targets is

   --  Define some global statistics about the memory slots.
   type Memory_Stat is record
      Thread_Count  : Natural := 0;
      Total_Alloc   : MAT.Types.Target_Size := 0;
      Total_Free    : MAT.Types.Target_Size := 0;
      Malloc_Count  : Natural := 0;
      Free_Count    : Natural := 0;
      Realloc_Count : Natural := 0;
   end record;

   type Target_Memory is tagged limited private;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation);

   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation);

   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   procedure Probe_Realloc (Memory   : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type);

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

   --  Collect the information about threads and the memory allocations they've made.
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map);

   --  Collect the information about frames and the memory allocations they've made.
   procedure Frame_Information (Memory : in out Target_Memory;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map);

   --  Get the global memory and allocation statistics.
   procedure Stat_Information (Memory : in out Target_Memory;
                               Result : out Memory_Stat);

   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map);

private

   protected type Memory_Allocator is

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation);

      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation);

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type);

      --  Collect the information about memory slot sizes allocated by the application.
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

      --  Collect the information about threads and the memory allocations they've made.
      procedure Thread_Information (Threads : in out Memory_Info_Map);

      --  Collect the information about frames and the memory allocations they've made.
      procedure Frame_Information (Level  : in Natural;
                                   Frames : in out Frame_Info_Map);

      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map);

      --  Get the global memory and allocation statistics.
      procedure Stat_Information (Result : out Memory_Stat);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Stats         : Memory_Stat;
      Frames        : MAT.Frames.Frame_Type := MAT.Frames.Create_Root;
   end Memory_Allocator;

   type Target_Memory is tagged limited record
      Reader        : MAT.Readers.Reader_Access;
      Memory        : Memory_Allocator;
   end record;

end MAT.Memory.Targets;

-----------------------------------------------------------------------
--  Memory clients - Client info related to its 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 MAT.Frames;
with MAT.Readers;
with MAT.Memory.Tools;
with MAT.Expressions;
package MAT.Memory.Targets is

   --  Define some global statistics about the memory slots.
   type Memory_Stat is record
      Thread_Count  : Natural := 0;
      Total_Alloc   : MAT.Types.Target_Size := 0;
      Total_Free    : MAT.Types.Target_Size := 0;
      Malloc_Count  : Natural := 0;
      Free_Count    : Natural := 0;
      Realloc_Count : Natural := 0;
   end record;

   type Target_Memory is tagged limited private;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation);

   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation);

   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   procedure Probe_Realloc (Memory   : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type);

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

   --  Collect the information about threads and the memory allocations they've made.
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map);

   --  Collect the information about frames and the memory allocations they've made.
   procedure Frame_Information (Memory : in out Target_Memory;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map);

   --  Get the global memory and allocation statistics.
   procedure Stat_Information (Memory : in out Target_Memory;
                               Result : out Memory_Stat);

   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map);

private

   protected type Memory_Allocator is

      --  Add the memory region from the list of memory region managed by the program.
      procedure Add_Region (Region : in Region_Info);

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation);

      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation);

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type);

      --  Collect the information about memory slot sizes allocated by the application.
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

      --  Collect the information about threads and the memory allocations they've made.
      procedure Thread_Information (Threads : in out Memory_Info_Map);

      --  Collect the information about frames and the memory allocations they've made.
      procedure Frame_Information (Level  : in Natural;
                                   Frames : in out Frame_Info_Map);

      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map);

      --  Get the global memory and allocation statistics.
      procedure Stat_Information (Result : out Memory_Stat);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Regions       : Region_Info_Map;
      Stats         : Memory_Stat;
      Frames        : MAT.Frames.Frame_Type := MAT.Frames.Create_Root;
   end Memory_Allocator;

   type Target_Memory is tagged limited record
      Reader        : MAT.Readers.Reader_Access;
      Memory        : Memory_Allocator;
   end record;

end MAT.Memory.Targets;

Define the protected operation Add_Region


-----------------------------------------------------------------------
--  mat-commands -- Command support and execution
--  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 GNAT.Sockets;

with MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      Interactive : Boolean := True;
      Graphical   : Boolean := False;
      Address     : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type'Class);

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type'Class;
                                 Options : in out Options_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

end MAT.Commands;

-----------------------------------------------------------------------
--  mat-commands -- Command support and execution
--  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 GNAT.Sockets;

with MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      Interactive : Boolean := True;
      Graphical   : Boolean := False;
      Address     : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type'Class);

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type'Class;
                                 Options : in out Options_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

end MAT.Commands;

Declare the Usage procedure

Declare the Usage procedure


-----------------------------------------------------------------------
--  core-factory -- Factory for Core UI Components
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;
with Ada.Exceptions;
with Ada.Strings.Maps;
with ASF.Views.Nodes;
with ASF.Locales;
with ASF.Components.Utils.Files;
with ASF.Components.Utils.Flush;
with ASF.Components.Utils.Scripts;
with ASF.Components.Utils.Escapes;
with ASF.Components.Utils.Beans;
with ASF.Components.Html.Messages;
with ASF.Applications.Main;

with Util.Log.Loggers;
with Util.Properties.Bundles;
with Util.Dates.Formats;
with Util.Dates.ISO8601;
with Util.Beans.Objects.Time;
with Util.Locales;
with Util.Encoders.SHA256;
with Util.Strings.Transforms; use Util.Strings;

package body ASF.Components.Utils.Factory is

   use ASF.Components.Base;

   --  The logger
   Log : constant Util.Log.Loggers.Logger
     := Util.Log.Loggers.Create ("ASF.Components.Utils.Factory");

   function Create_File return UIComponent_Access;
   function Create_Flush return UIComponent_Access;
   function Create_Script return UIComponent_Access;
   function Create_Escape return UIComponent_Access;
   function Create_Set return UIComponent_Access;

   --  -------------------------
   --  ------------------------------
   --  Create a UIFile component
   --  ------------------------------
   function Create_File return UIComponent_Access is
   begin
      return new ASF.Components.Utils.Files.UIFile;
   end Create_File;

   --  ------------------------------
   --  Create a UIFlush component
   --  ------------------------------
   function Create_Flush return UIComponent_Access is
   begin
      return new ASF.Components.Utils.Flush.UIFlush;
   end Create_Flush;

   --  ------------------------------
   --  Create a UIScript component
   --  ------------------------------
   function Create_Script return UIComponent_Access is
   begin
      return new ASF.Components.Utils.Scripts.UIScript;
   end Create_Script;

   --  ------------------------------
   --  Create a UIEscape component
   --  ------------------------------
   function Create_Escape return UIComponent_Access is
   begin
      return new ASF.Components.Utils.Escapes.UIEscape;
   end Create_Escape;

   --  ------------------------------
   --  Create a UISetBean component
   --  ------------------------------
   function Create_Set return UIComponent_Access is
   begin
      return new ASF.Components.Utils.Beans.UISetBean;
   end Create_Set;

   use ASF.Views.Nodes;

   URI        : aliased constant String := "http://code.google.com/p/ada-asf/util";
   ESCAPE_TAG : aliased constant String := "escape";
   FILE_TAG   : aliased constant String := "file";
   FLUSH_TAG  : aliased constant String := "flush";
   SCRIPT_TAG : aliased constant String := "script";
   SET_TAG    : aliased constant String := "set";

   Core_Bindings : aliased constant ASF.Factory.Binding_Array
     := (1 => (Name      => ESCAPE_TAG'Access,
               Component => Create_Escape'Access,
               Tag       => Create_Component_Node'Access),
         2 => (Name      => FILE_TAG'Access,
               Component => Create_File'Access,
               Tag       => Create_Component_Node'Access),
         3 => (Name      => FLUSH_TAG'Access,
               Component => Create_Flush'Access,
               Tag       => Create_Component_Node'Access),
         4 => (Name      => SCRIPT_TAG'Access,
               Component => Create_Script'Access,
               Tag       => Create_Component_Node'Access),
         5 => (Name      => SET_TAG'Access,
               Component => Create_Set'Access,
               Tag       => Create_Component_Node'Access)
        );

   Core_Factory : aliased constant ASF.Factory.Factory_Bindings
     := (URI => URI'Access, Bindings => Core_Bindings'Access);

   --  ------------------------------
   --  Get the HTML component factory.
   --  ------------------------------
   function Definition return ASF.Factory.Factory_Bindings_Access is
   begin
      return Core_Factory'Access;
   end Definition;

   --  Truncate the string representation represented by Value to
   --  the length specified by Size.
   function Escape_Javascript (Value : EL.Objects.Object) return EL.Objects.Object;

   --  Escape the string using XML escape rules.
   function Escape_Xml (Value : EL.Objects.Object) return EL.Objects.Object;

   --  Translate the value into an ISO8606 date.
   function To_ISO8601 (Value : in EL.Objects.Object) return EL.Objects.Object;

   --  Encode the string for URL.
   function Url_Encode (Value : in EL.Objects.Object) return EL.Objects.Object;

   --  Encode the object into a SHA256.
   function SHA256 (Value : in EL.Objects.Object) return EL.Objects.Object;
   function SHA256_Base64 (Value : in EL.Objects.Object) return EL.Objects.Object;

   --  Format a date using the given date pattern.
   function Format_Date (Date   : in EL.Objects.Object;
                         Format : in EL.Objects.Object) return EL.Objects.Object;

   --  Translate a value using a resource bundle and applying a prefix for the translation.
   function Translate (Bundle  : in EL.Objects.Object;
                       Prefix  : in EL.Objects.Object;
                       Value   : in EL.Objects.Object) return EL.Objects.Object;

   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
   begin
      Mapper.Set_Function (Name      => "escapeJavaScript",
                           Namespace => URI,
                           Func      => Escape_Javascript'Access);
      Mapper.Set_Function (Name      => "escapeXml",
                           Namespace => URI,
                           Func      => Escape_Xml'Access);
      Mapper.Set_Function (Name      => "formatDate",
                           Namespace => URI,
                           Func      => Format_Date'Access);
      Mapper.Set_Function (Name      => "iso8601",
                           Namespace => URI,
                           Func      => To_ISO8601'Access);
      Mapper.Set_Function (Name      => "hasMessage",
                           Namespace => URI,
                           Func      => ASF.Components.Html.Messages.Has_Message'Access,
                           Optimize  => False);
      Mapper.Set_Function (Name      => "urlEncode",
                           Namespace => URI,
                           Func      => Url_Encode'Access,
                           Optimize  => False);
      Mapper.Set_Function (Name      => "translate",
                           Namespace => URI,
                           Func      => Translate'Access);
      Mapper.Set_Function (Name      => "sha256base64",
                           Namespace => URI,
                           Func      => SHA256_Base64'Access);
      Mapper.Set_Function (Name      => "sha256",
                           Namespace => URI,
                           Func      => SHA256'Access);
   end Set_Functions;

   function Escape_Javascript (Value : EL.Objects.Object) return EL.Objects.Object is
      Result  : Ada.Strings.Unbounded.Unbounded_String;
      Content : constant String := EL.Objects.To_String (Value);
   begin
      Transforms.Escape_Javascript (Content => Content,
                                    Into    => Result);
      return EL.Objects.To_Object (Result);
   end Escape_Javascript;

   function Escape_Xml (Value : EL.Objects.Object) return EL.Objects.Object is
      Result  : Ada.Strings.Unbounded.Unbounded_String;
      Content : constant String := EL.Objects.To_String (Value);
   begin
      Transforms.Escape_Xml (Content => Content,
                             Into    => Result);
      return EL.Objects.To_Object (Result);
   end Escape_Xml;

   --  ------------------------------
   --  Translate the value into an ISO8606 date.
   --  ------------------------------
   function To_ISO8601 (Value : in EL.Objects.Object) return EL.Objects.Object is
      D : constant Ada.Calendar.Time := Util.Beans.Objects.Time.To_Time (Value);
      S : constant String := Util.Dates.ISO8601.Image (D);
   begin
      return Util.Beans.Objects.To_Object (S);
   end To_ISO8601;

   --  ------------------------------
   --  Format a date using the given date pattern.
   --  ------------------------------
   function Format_Date (Date   : in EL.Objects.Object;
                         Format : in EL.Objects.Object) return EL.Objects.Object is
      Context : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Locale  : constant Util.Locales.Locale := Context.Get_Locale;
      Bundle  : ASF.Locales.Bundle;
   begin
      begin
         ASF.Applications.Main.Load_Bundle (Context.Get_Application.all,
                                            Name   => "asf",
                                            Locale => Util.Locales.To_String (Locale),
                                            Bundle => Bundle);

      exception
         when E : Util.Properties.Bundles.NO_BUNDLE =>
            Log.Error ("Cannot localize dates: {0}", Ada.Exceptions.Exception_Message (E));
      end;
      declare
         Time    : constant Ada.Calendar.Time := Util.Beans.Objects.Time.To_Time (Date);
         Pattern : constant String := Util.Beans.Objects.To_String (Format);
         Result  : constant String := Util.Dates.Formats.Format (Pattern, Time, Bundle);
      begin
         return EL.Objects.To_Object (Result);
      end;
   end Format_Date;

   --  ------------------------------
   --  Translate a value using a resource bundle and applying a prefix for the translation.
   --  ------------------------------
   function Translate (Bundle  : in EL.Objects.Object;
                       Prefix  : in EL.Objects.Object;
                       Value   : in EL.Objects.Object) return EL.Objects.Object is
      Bean    : access Util.Beans.Basic.Readonly_Bean'Class;
   begin
      Bean := Util.Beans.Objects.To_Bean (Bundle);
      if Bean = null then
         return Value;
      else
         return Bean.Get_Value (EL.Objects.To_String (Prefix) & EL.Objects.To_String (Value));
      end if;
   end Translate;

   use Ada.Strings.Maps;

   Conversion     : constant String (1 .. 16) := "0123456789ABCDEF";
   Url_Encode_Set : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (Span => (Low  => Character'Val (0),
                                          High => ' '))
     or
       Ada.Strings.Maps.To_Set (Span => (Low => Character'Val (128),
                                         High => Character'Val (255)))
     or
       Ada.Strings.Maps.To_Set (":/?#[]@!$&'""()*+,;=");

   --  ------------------------------
   --  Encode the string for URL.
   --  ------------------------------
   function Url_Encode (Value : in EL.Objects.Object) return EL.Objects.Object is
      S   : constant String := Util.Beans.Objects.To_String (Value);
      T   : String (1 .. S'Length * 3);
      Pos : Positive := 1;
      C   : Character;
   begin
      for I in S'Range loop
         C := S (I);
         if Ada.Strings.Maps.Is_In (C, Url_Encode_Set) then
            T (Pos) := '%';
            T (Pos + 1) := Conversion (1 + Character'Pos (C) / 16);
            T (Pos + 2) := Conversion (1 + Character'Pos (C) mod 16);
            Pos := Pos + 3;
         else
            T (Pos) := C;
            Pos := Pos + 1;
         end if;
      end loop;
      return Util.Beans.Objects.To_Object (T (1 .. Pos - 1));
   end Url_Encode;

   --  ------------------------------
   --  Encode the object into a SHA256.
   --  ------------------------------
   function SHA256_Base64 (Value : in EL.Objects.Object) return EL.Objects.Object is
      Content  : constant String := Util.Beans.Objects.To_String (Value);
      Context  : Util.Encoders.SHA256.Context;
      Result   : Util.Encoders.SHA256.Base64_Digest;
   begin
      Util.Encoders.SHA256.Update (Context, Content);
      Util.Encoders.SHA256.Finish_Base64 (Context, Result);
      return Util.Beans.Objects.To_Object (Result);
   end SHA256_Base64;

   --  ------------------------------
   --  Encode the object into a SHA256.
   --  ------------------------------
   function SHA256 (Value : in EL.Objects.Object) return EL.Objects.Object is
      Content  : constant String := Util.Beans.Objects.To_String (Value);
      Context  : Util.Encoders.SHA256.Context;
      Result   : Util.Encoders.SHA256.Digest;
   begin
      Util.Encoders.SHA256.Update (Context, Content);
      Util.Encoders.SHA256.Finish (Context, Result);
      return Util.Beans.Objects.To_Object (Result);
   end SHA256;

end ASF.Components.Utils.Factory;

-----------------------------------------------------------------------
--  core-factory -- Factory for Core UI Components
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;
with Ada.Exceptions;
with Ada.Strings.Maps;
with ASF.Views.Nodes;
with ASF.Locales;
with ASF.Components.Utils.Files;
with ASF.Components.Utils.Flush;
with ASF.Components.Utils.Scripts;
with ASF.Components.Utils.Escapes;
with ASF.Components.Utils.Beans;
with ASF.Components.Html.Messages;
with ASF.Applications.Main;

with Util.Log.Loggers;
with Util.Properties.Bundles;
with Util.Dates.Formats;
with Util.Dates.ISO8601;
with Util.Beans.Objects.Time;
with Util.Locales;
with Util.Encoders.SHA256;
with Util.Strings.Transforms; use Util.Strings;

package body ASF.Components.Utils.Factory is

   use ASF.Components.Base;

   --  The logger
   Log : constant Util.Log.Loggers.Logger
     := Util.Log.Loggers.Create ("ASF.Components.Utils.Factory");

   function Create_File return UIComponent_Access;
   function Create_Flush return UIComponent_Access;
   function Create_Script return UIComponent_Access;
   function Create_Escape return UIComponent_Access;
   function Create_Set return UIComponent_Access;

   --  -------------------------
   --  ------------------------------
   --  Create a UIFile component
   --  ------------------------------
   function Create_File return UIComponent_Access is
   begin
      return new ASF.Components.Utils.Files.UIFile;
   end Create_File;

   --  ------------------------------
   --  Create a UIFlush component
   --  ------------------------------
   function Create_Flush return UIComponent_Access is
   begin
      return new ASF.Components.Utils.Flush.UIFlush;
   end Create_Flush;

   --  ------------------------------
   --  Create a UIScript component
   --  ------------------------------
   function Create_Script return UIComponent_Access is
   begin
      return new ASF.Components.Utils.Scripts.UIScript;
   end Create_Script;

   --  ------------------------------
   --  Create a UIEscape component
   --  ------------------------------
   function Create_Escape return UIComponent_Access is
   begin
      return new ASF.Components.Utils.Escapes.UIEscape;
   end Create_Escape;

   --  ------------------------------
   --  Create a UISetBean component
   --  ------------------------------
   function Create_Set return UIComponent_Access is
   begin
      return new ASF.Components.Utils.Beans.UISetBean;
   end Create_Set;

   use ASF.Views.Nodes;

   URI        : aliased constant String := "http://code.google.com/p/ada-asf/util";
   ESCAPE_TAG : aliased constant String := "escape";
   FILE_TAG   : aliased constant String := "file";
   FLUSH_TAG  : aliased constant String := "flush";
   SCRIPT_TAG : aliased constant String := "script";
   SET_TAG    : aliased constant String := "set";

   --  ------------------------------
   --  Register the HTML component factory.
   --  ------------------------------
   procedure Register (Factory : in out ASF.Factory.Component_Factory) is
   begin
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => ESCAPE_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Escape'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => FILE_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_File'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => FLUSH_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Flush'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SCRIPT_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Script'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SET_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Set'Access);
   end Register;

   --  Truncate the string representation represented by Value to
   --  the length specified by Size.
   function Escape_Javascript (Value : EL.Objects.Object) return EL.Objects.Object;

   --  Escape the string using XML escape rules.
   function Escape_Xml (Value : EL.Objects.Object) return EL.Objects.Object;

   --  Translate the value into an ISO8606 date.
   function To_ISO8601 (Value : in EL.Objects.Object) return EL.Objects.Object;

   --  Encode the string for URL.
   function Url_Encode (Value : in EL.Objects.Object) return EL.Objects.Object;

   --  Encode the object into a SHA256.
   function SHA256 (Value : in EL.Objects.Object) return EL.Objects.Object;
   function SHA256_Base64 (Value : in EL.Objects.Object) return EL.Objects.Object;

   --  Format a date using the given date pattern.
   function Format_Date (Date   : in EL.Objects.Object;
                         Format : in EL.Objects.Object) return EL.Objects.Object;

   --  Translate a value using a resource bundle and applying a prefix for the translation.
   function Translate (Bundle  : in EL.Objects.Object;
                       Prefix  : in EL.Objects.Object;
                       Value   : in EL.Objects.Object) return EL.Objects.Object;

   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
   begin
      Mapper.Set_Function (Name      => "escapeJavaScript",
                           Namespace => URI,
                           Func      => Escape_Javascript'Access);
      Mapper.Set_Function (Name      => "escapeXml",
                           Namespace => URI,
                           Func      => Escape_Xml'Access);
      Mapper.Set_Function (Name      => "formatDate",
                           Namespace => URI,
                           Func      => Format_Date'Access);
      Mapper.Set_Function (Name      => "iso8601",
                           Namespace => URI,
                           Func      => To_ISO8601'Access);
      Mapper.Set_Function (Name      => "hasMessage",
                           Namespace => URI,
                           Func      => ASF.Components.Html.Messages.Has_Message'Access,
                           Optimize  => False);
      Mapper.Set_Function (Name      => "urlEncode",
                           Namespace => URI,
                           Func      => Url_Encode'Access,
                           Optimize  => False);
      Mapper.Set_Function (Name      => "translate",
                           Namespace => URI,
                           Func      => Translate'Access);
      Mapper.Set_Function (Name      => "sha256base64",
                           Namespace => URI,
                           Func      => SHA256_Base64'Access);
      Mapper.Set_Function (Name      => "sha256",
                           Namespace => URI,
                           Func      => SHA256'Access);
   end Set_Functions;

   function Escape_Javascript (Value : EL.Objects.Object) return EL.Objects.Object is
      Result  : Ada.Strings.Unbounded.Unbounded_String;
      Content : constant String := EL.Objects.To_String (Value);
   begin
      Transforms.Escape_Javascript (Content => Content,
                                    Into    => Result);
      return EL.Objects.To_Object (Result);
   end Escape_Javascript;

   function Escape_Xml (Value : EL.Objects.Object) return EL.Objects.Object is
      Result  : Ada.Strings.Unbounded.Unbounded_String;
      Content : constant String := EL.Objects.To_String (Value);
   begin
      Transforms.Escape_Xml (Content => Content,
                             Into    => Result);
      return EL.Objects.To_Object (Result);
   end Escape_Xml;

   --  ------------------------------
   --  Translate the value into an ISO8606 date.
   --  ------------------------------
   function To_ISO8601 (Value : in EL.Objects.Object) return EL.Objects.Object is
      D : constant Ada.Calendar.Time := Util.Beans.Objects.Time.To_Time (Value);
      S : constant String := Util.Dates.ISO8601.Image (D);
   begin
      return Util.Beans.Objects.To_Object (S);
   end To_ISO8601;

   --  ------------------------------
   --  Format a date using the given date pattern.
   --  ------------------------------
   function Format_Date (Date   : in EL.Objects.Object;
                         Format : in EL.Objects.Object) return EL.Objects.Object is
      Context : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Locale  : constant Util.Locales.Locale := Context.Get_Locale;
      Bundle  : ASF.Locales.Bundle;
   begin
      begin
         ASF.Applications.Main.Load_Bundle (Context.Get_Application.all,
                                            Name   => "asf",
                                            Locale => Util.Locales.To_String (Locale),
                                            Bundle => Bundle);

      exception
         when E : Util.Properties.Bundles.NO_BUNDLE =>
            Log.Error ("Cannot localize dates: {0}", Ada.Exceptions.Exception_Message (E));
      end;
      declare
         Time    : constant Ada.Calendar.Time := Util.Beans.Objects.Time.To_Time (Date);
         Pattern : constant String := Util.Beans.Objects.To_String (Format);
         Result  : constant String := Util.Dates.Formats.Format (Pattern, Time, Bundle);
      begin
         return EL.Objects.To_Object (Result);
      end;
   end Format_Date;

   --  ------------------------------
   --  Translate a value using a resource bundle and applying a prefix for the translation.
   --  ------------------------------
   function Translate (Bundle  : in EL.Objects.Object;
                       Prefix  : in EL.Objects.Object;
                       Value   : in EL.Objects.Object) return EL.Objects.Object is
      Bean    : access Util.Beans.Basic.Readonly_Bean'Class;
   begin
      Bean := Util.Beans.Objects.To_Bean (Bundle);
      if Bean = null then
         return Value;
      else
         return Bean.Get_Value (EL.Objects.To_String (Prefix) & EL.Objects.To_String (Value));
      end if;
   end Translate;

   use Ada.Strings.Maps;

   Conversion     : constant String (1 .. 16) := "0123456789ABCDEF";
   Url_Encode_Set : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (Span => (Low  => Character'Val (0),
                                          High => ' '))
     or
       Ada.Strings.Maps.To_Set (Span => (Low => Character'Val (128),
                                         High => Character'Val (255)))
     or
       Ada.Strings.Maps.To_Set (":/?#[]@!$&'""()*+,;=");

   --  ------------------------------
   --  Encode the string for URL.
   --  ------------------------------
   function Url_Encode (Value : in EL.Objects.Object) return EL.Objects.Object is
      S   : constant String := Util.Beans.Objects.To_String (Value);
      T   : String (1 .. S'Length * 3);
      Pos : Positive := 1;
      C   : Character;
   begin
      for I in S'Range loop
         C := S (I);
         if Ada.Strings.Maps.Is_In (C, Url_Encode_Set) then
            T (Pos) := '%';
            T (Pos + 1) := Conversion (1 + Character'Pos (C) / 16);
            T (Pos + 2) := Conversion (1 + Character'Pos (C) mod 16);
            Pos := Pos + 3;
         else
            T (Pos) := C;
            Pos := Pos + 1;
         end if;
      end loop;
      return Util.Beans.Objects.To_Object (T (1 .. Pos - 1));
   end Url_Encode;

   --  ------------------------------
   --  Encode the object into a SHA256.
   --  ------------------------------
   function SHA256_Base64 (Value : in EL.Objects.Object) return EL.Objects.Object is
      Content  : constant String := Util.Beans.Objects.To_String (Value);
      Context  : Util.Encoders.SHA256.Context;
      Result   : Util.Encoders.SHA256.Base64_Digest;
   begin
      Util.Encoders.SHA256.Update (Context, Content);
      Util.Encoders.SHA256.Finish_Base64 (Context, Result);
      return Util.Beans.Objects.To_Object (Result);
   end SHA256_Base64;

   --  ------------------------------
   --  Encode the object into a SHA256.
   --  ------------------------------
   function SHA256 (Value : in EL.Objects.Object) return EL.Objects.Object is
      Content  : constant String := Util.Beans.Objects.To_String (Value);
      Context  : Util.Encoders.SHA256.Context;
      Result   : Util.Encoders.SHA256.Digest;
   begin
      Util.Encoders.SHA256.Update (Context, Content);
      Util.Encoders.SHA256.Finish (Context, Result);
      return Util.Beans.Objects.To_Object (Result);
   end SHA256;

end ASF.Components.Utils.Factory;

Change the Definition function into a Register procedure