-----------------------------------------------------------------------
--  mat-readers-tests -- Unit tests for MAT readers
--  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 Ada.Text_IO;
with Ada.Directories;
with Util.Test_Caller;

with MAT.Frames.Print;
with MAT.Readers.Files;
package body MAT.Frames.Tests is

   use Util.Tests;

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

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

   Frame_1_1 : constant Frame_Table (1 .. 15) :=
     (1_0, 1_2, 1_3, 1_4, 1_5, 1_6, 1_7, 1_8, 1_9, 1_10,
      1_11, 1_12, 1_13, 1_14, 1_15);

   Frame_1_2 : constant Frame_Table (1 .. 16) :=
     (1_0, 1_2, 1_3, 1_4, 1_5, 1_6, 1_7, 1_8, 1_9, 1_10,
      1_11, 1_12, 1_13, 1_14, 1_20, 1_21);

   Frame_1_3 : constant Frame_Table (1 .. 15) :=
     (1_0, 1_2, 1_3, 1_4, 1_5, 1_6, 1_7, 1_8, 1_9, 1_10,
      1_11, 1_12, 1_13, 1_14, 1_30);

   Frame_2_0 : constant Frame_Table (1 .. 10) :=
     (2_0, 2_2, 2_3, 2_4, 2_5, 2_6, 2_7, 2_8, 2_9, 2_10);

   Frame_2_1 : constant Frame_Table (1 .. 10) :=
     (2_0, 2_1, 2_1, 2_1, 2_1, 2_1, 2_1, 2_1, 2_1, 2_10);

   Frame_2_2 : constant Frame_Table (1 .. 10) :=
     (2_0, 2_1, 2_2, 2_1, 2_1, 2_1, 2_1, 2_1, 2_1, 2_1);

   Frame_2_3 : constant Frame_Table (1 .. 10) :=
     (2_0, 2_1, 2_2, 2_1, 2_1, 2_3, 2_1, 2_1, 2_1, 2_1);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test MAT.Frames.Insert",
                       Test_Simple_Frames'Access);
      Caller.Add_Test (Suite, "Test MAT.Frames.Find",
                       Test_Find_Frames'Access);
      Caller.Add_Test (Suite, "Test MAT.Frames.Backtrace",
                       Test_Complex_Frames'Access);
      Caller.Add_Test (Suite, "Test MAT.Frames.Release",
                       Test_Release_Frames'Access);
   end Add_Tests;

   --  ------------------------------
   --  Create a tree with the well known test frames.
   --  ------------------------------
   function Create_Test_Frames return Frame_Type is
      Root : Frame_Type := Create_Root;
      F    : Frame_Type;
   begin
      Insert (Root, Frame_1_0, F);
      Insert (Root, Frame_1_1, F);
      Insert (Root, Frame_1_2, F);
      Insert (Root, Frame_1_3, F);
      Insert (Root, Frame_2_0, F);
      Insert (Root, Frame_2_1, F);
      Insert (Root, Frame_2_2, F);
      Insert (Root, Frame_2_3, F);
      return Root;
   end Create_Test_Frames;

   --  ------------------------------
   --  Basic consistency checks when creating the test tree
   --  ------------------------------
   procedure Test_Simple_Frames (T : in out Test) is
      Root : Frame_Type := Create_Root;
      F    : Frame_Type;
   begin
      --  Consistency check on empty tree.
      Util.Tests.Assert_Equals (T, 0, Count_Children (Root),
                                "Empty frame: Count_Children must return 0");
      Util.Tests.Assert_Equals (T, 0, Current_Depth (Root),
                                "Empty frame: Current_Depth must return 0");

      --  Insert first frame and verify consistency.
      Insert (Root, Frame_1_0, F);
      Util.Tests.Assert_Equals (T, 1, Count_Children (Root),
                                "Simple frame: Count_Children must return 1");
      Util.Tests.Assert_Equals (T, 10, Current_Depth (F),
                                "Simple frame: Current_Depth must return 10");
--        Expect (Msg    => "Frames.Count_Children",
--                Val    => 1,
--                Result => Count_Children (Root));
--        Expect (Msg    => "Frames.Count_Children(recursive)",
--                Val    => 1,
--                Result => Count_Children (Root, True));
--        Expect (Msg    => "Frames.Current_Depth",
--                Val    => 10,
--                Result => Current_Depth (F));

      Insert (Root, Frame_1_1, F);
      Insert (Root, Frame_1_2, F);
      Insert (Root, Frame_1_3, F);
      if Verbose then
         MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      end if;
      Util.Tests.Assert_Equals (T, 1, Count_Children (Root),
                                "Simple frame: Count_Children must return 1");
      Util.Tests.Assert_Equals (T, 3, Count_Children (Root, True),
                                "Simple frame: Count_Children (recursive) must return 3");
      Util.Tests.Assert_Equals (T, 15, Current_Depth (F),
                                "Simple frame: Current_Depth must return 15");

      Insert (Root, Frame_2_0, F);
      Insert (Root, Frame_2_1, F);
      Insert (Root, Frame_2_2, F);
      Insert (Root, Frame_2_3, F);
      if Verbose then
         MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      end if;
      Util.Tests.Assert_Equals (T, 2, Count_Children (Root),
                                "Simple frame: Count_Children must return 2");
      Util.Tests.Assert_Equals (T, 7, Count_Children (Root, True),
                                "Simple frame: Count_Children (recursive) must return 7");
      Util.Tests.Assert_Equals (T, 10, Current_Depth (F),
                                "Simple frame: Current_Depth must return 10");

      Destroy (Root);
   end Test_Simple_Frames;

   --  ------------------------------
   --  Test searching in the frame.
   --  ------------------------------
   procedure Test_Find_Frames (T : in out Test) is
      Root    : Frame_Type := Create_Test_Frames;
      Result  : Frame_Type;
      Last_Pc : Natural;
   begin
      --  Find exact frame.
      Find (Root, Frame_2_3, Result, Last_Pc);
      T.Assert (Result /= Root, "Frames.Find must return a valid frame");
      T.Assert (Last_Pc = 0, "Frames.Find must return a 0 Last_Pc");

      declare
         Pc : Frame_Table (1 .. 8) := Frame_2_3 (1 .. 8);
      begin
         Find (Root, Pc, Result, Last_Pc);

         T.Assert (Result /= Root, "Frames.Find must return a valid frame");
--           Expect (Msg    => "Frames.Find (Last_Pc param)",
--                   Val    => 0,
--                   Result => Last_Pc);
      end;

      Destroy (Root);
   end Test_Find_Frames;

   --  ------------------------------
   --  Create a complex frame tree and run tests on it.
   --  ------------------------------
   procedure Test_Complex_Frames (T : in out Test) is

      Pc   : Frame_Table (1 .. 8);
      Root : Frame_Type := Create_Root;

      procedure Create_Frame (Depth : in Natural);

      procedure Create_Frame (Depth : in Natural) is
         use type MAT.Types.Target_Addr;
         use type MAT.Events.Frame_Table;

         F : Frame_Type;
      begin
         Pc (Depth) := MAT.Types.Target_Addr (Depth);
         if Depth < Pc'Last then
            Create_Frame (Depth + 1);
         end if;

         Insert (Root, Pc (1 .. Depth), F);
         Pc (Depth) := MAT.Types.Target_Addr (Depth) + 1000;
         Insert (Root, Pc (1 .. Depth), F);
         if Depth < Pc'Last then
            Create_Frame (Depth + 1);
         end if;

         declare
            Read_Pc : Frame_Table := Backtrace (F);
         begin
            T.Assert (Read_Pc = Pc (1 .. Depth), "Frames.backtrace (same as inserted)");
            if Verbose then
               for I in Read_Pc'Range loop
                  Ada.Text_IO.Put (" " & MAT.Types.Target_Addr'Image (Read_Pc (I)));
               end loop;
               Ada.Text_IO.New_Line;
            end if;
         end;
      end Create_Frame;

   begin
      Create_Frame (1);
      if Verbose then
         MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      end if;
      Destroy (Root);
   end Test_Complex_Frames;

   --  ------------------------------
   --  Test allocating and releasing frames.
   --  ------------------------------
   procedure Test_Release_Frames (T : in out Test) is
      Root : Frame_Type := Create_Root;
      F1   : Frame_Type;
      F2   : Frame_Type;
      F3   : Frame_Type;
   begin
      Insert (Root, Frame_1_1, F1);
      T.Assert (Root.Used > 0, "Insert must increment the root used count");
      MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      Insert (Root, Frame_1_2, F2);
      MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      Insert (Root, Frame_1_3, F3);
      MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Output, "Release frame F1");
      Release (F1);
      MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      T.Assert (F2.Used > 0, "Release must not change other frames");
      T.Assert (Root.Used > 0, "Release must not change root frame");
      Destroy (Root);
   end Test_Release_Frames;

end MAT.Frames.Tests;

-----------------------------------------------------------------------
--  mat-readers-tests -- Unit tests for MAT readers
--  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 Ada.Text_IO;
with Ada.Directories;
with Util.Test_Caller;

with MAT.Frames.Print;
with MAT.Readers.Streams.Files;
package body MAT.Frames.Tests is

   use Util.Tests;

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

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

   Frame_1_1 : constant Frame_Table (1 .. 15) :=
     (1_0, 1_2, 1_3, 1_4, 1_5, 1_6, 1_7, 1_8, 1_9, 1_10,
      1_11, 1_12, 1_13, 1_14, 1_15);

   Frame_1_2 : constant Frame_Table (1 .. 16) :=
     (1_0, 1_2, 1_3, 1_4, 1_5, 1_6, 1_7, 1_8, 1_9, 1_10,
      1_11, 1_12, 1_13, 1_14, 1_20, 1_21);

   Frame_1_3 : constant Frame_Table (1 .. 15) :=
     (1_0, 1_2, 1_3, 1_4, 1_5, 1_6, 1_7, 1_8, 1_9, 1_10,
      1_11, 1_12, 1_13, 1_14, 1_30);

   Frame_2_0 : constant Frame_Table (1 .. 10) :=
     (2_0, 2_2, 2_3, 2_4, 2_5, 2_6, 2_7, 2_8, 2_9, 2_10);

   Frame_2_1 : constant Frame_Table (1 .. 10) :=
     (2_0, 2_1, 2_1, 2_1, 2_1, 2_1, 2_1, 2_1, 2_1, 2_10);

   Frame_2_2 : constant Frame_Table (1 .. 10) :=
     (2_0, 2_1, 2_2, 2_1, 2_1, 2_1, 2_1, 2_1, 2_1, 2_1);

   Frame_2_3 : constant Frame_Table (1 .. 10) :=
     (2_0, 2_1, 2_2, 2_1, 2_1, 2_3, 2_1, 2_1, 2_1, 2_1);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test MAT.Frames.Insert",
                       Test_Simple_Frames'Access);
      Caller.Add_Test (Suite, "Test MAT.Frames.Find",
                       Test_Find_Frames'Access);
      Caller.Add_Test (Suite, "Test MAT.Frames.Backtrace",
                       Test_Complex_Frames'Access);
      Caller.Add_Test (Suite, "Test MAT.Frames.Release",
                       Test_Release_Frames'Access);
   end Add_Tests;

   --  ------------------------------
   --  Create a tree with the well known test frames.
   --  ------------------------------
   function Create_Test_Frames return Frame_Type is
      Root : Frame_Type := Create_Root;
      F    : Frame_Type;
   begin
      Insert (Root, Frame_1_0, F);
      Insert (Root, Frame_1_1, F);
      Insert (Root, Frame_1_2, F);
      Insert (Root, Frame_1_3, F);
      Insert (Root, Frame_2_0, F);
      Insert (Root, Frame_2_1, F);
      Insert (Root, Frame_2_2, F);
      Insert (Root, Frame_2_3, F);
      return Root;
   end Create_Test_Frames;

   --  ------------------------------
   --  Basic consistency checks when creating the test tree
   --  ------------------------------
   procedure Test_Simple_Frames (T : in out Test) is
      Root : Frame_Type := Create_Root;
      F    : Frame_Type;
   begin
      --  Consistency check on empty tree.
      Util.Tests.Assert_Equals (T, 0, Count_Children (Root),
                                "Empty frame: Count_Children must return 0");
      Util.Tests.Assert_Equals (T, 0, Current_Depth (Root),
                                "Empty frame: Current_Depth must return 0");

      --  Insert first frame and verify consistency.
      Insert (Root, Frame_1_0, F);
      Util.Tests.Assert_Equals (T, 1, Count_Children (Root),
                                "Simple frame: Count_Children must return 1");
      Util.Tests.Assert_Equals (T, 10, Current_Depth (F),
                                "Simple frame: Current_Depth must return 10");
--        Expect (Msg    => "Frames.Count_Children",
--                Val    => 1,
--                Result => Count_Children (Root));
--        Expect (Msg    => "Frames.Count_Children(recursive)",
--                Val    => 1,
--                Result => Count_Children (Root, True));
--        Expect (Msg    => "Frames.Current_Depth",
--                Val    => 10,
--                Result => Current_Depth (F));

      Insert (Root, Frame_1_1, F);
      Insert (Root, Frame_1_2, F);
      Insert (Root, Frame_1_3, F);
      if Verbose then
         MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      end if;
      Util.Tests.Assert_Equals (T, 1, Count_Children (Root),
                                "Simple frame: Count_Children must return 1");
      Util.Tests.Assert_Equals (T, 3, Count_Children (Root, True),
                                "Simple frame: Count_Children (recursive) must return 3");
      Util.Tests.Assert_Equals (T, 15, Current_Depth (F),
                                "Simple frame: Current_Depth must return 15");

      Insert (Root, Frame_2_0, F);
      Insert (Root, Frame_2_1, F);
      Insert (Root, Frame_2_2, F);
      Insert (Root, Frame_2_3, F);
      if Verbose then
         MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      end if;
      Util.Tests.Assert_Equals (T, 2, Count_Children (Root),
                                "Simple frame: Count_Children must return 2");
      Util.Tests.Assert_Equals (T, 7, Count_Children (Root, True),
                                "Simple frame: Count_Children (recursive) must return 7");
      Util.Tests.Assert_Equals (T, 10, Current_Depth (F),
                                "Simple frame: Current_Depth must return 10");

      Destroy (Root);
   end Test_Simple_Frames;

   --  ------------------------------
   --  Test searching in the frame.
   --  ------------------------------
   procedure Test_Find_Frames (T : in out Test) is
      Root    : Frame_Type := Create_Test_Frames;
      Result  : Frame_Type;
      Last_Pc : Natural;
   begin
      --  Find exact frame.
      Find (Root, Frame_2_3, Result, Last_Pc);
      T.Assert (Result /= Root, "Frames.Find must return a valid frame");
      T.Assert (Last_Pc = 0, "Frames.Find must return a 0 Last_Pc");

      declare
         Pc : Frame_Table (1 .. 8) := Frame_2_3 (1 .. 8);
      begin
         Find (Root, Pc, Result, Last_Pc);

         T.Assert (Result /= Root, "Frames.Find must return a valid frame");
--           Expect (Msg    => "Frames.Find (Last_Pc param)",
--                   Val    => 0,
--                   Result => Last_Pc);
      end;

      Destroy (Root);
   end Test_Find_Frames;

   --  ------------------------------
   --  Create a complex frame tree and run tests on it.
   --  ------------------------------
   procedure Test_Complex_Frames (T : in out Test) is

      Pc   : Frame_Table (1 .. 8);
      Root : Frame_Type := Create_Root;

      procedure Create_Frame (Depth : in Natural);

      procedure Create_Frame (Depth : in Natural) is
         use type MAT.Types.Target_Addr;
         use type MAT.Events.Frame_Table;

         F : Frame_Type;
      begin
         Pc (Depth) := MAT.Types.Target_Addr (Depth);
         if Depth < Pc'Last then
            Create_Frame (Depth + 1);
         end if;

         Insert (Root, Pc (1 .. Depth), F);
         Pc (Depth) := MAT.Types.Target_Addr (Depth) + 1000;
         Insert (Root, Pc (1 .. Depth), F);
         if Depth < Pc'Last then
            Create_Frame (Depth + 1);
         end if;

         declare
            Read_Pc : Frame_Table := Backtrace (F);
         begin
            T.Assert (Read_Pc = Pc (1 .. Depth), "Frames.backtrace (same as inserted)");
            if Verbose then
               for I in Read_Pc'Range loop
                  Ada.Text_IO.Put (" " & MAT.Types.Target_Addr'Image (Read_Pc (I)));
               end loop;
               Ada.Text_IO.New_Line;
            end if;
         end;
      end Create_Frame;

   begin
      Create_Frame (1);
      if Verbose then
         MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      end if;
      Destroy (Root);
   end Test_Complex_Frames;

   --  ------------------------------
   --  Test allocating and releasing frames.
   --  ------------------------------
   procedure Test_Release_Frames (T : in out Test) is
      Root : Frame_Type := Create_Root;
      F1   : Frame_Type;
      F2   : Frame_Type;
      F3   : Frame_Type;
   begin
      Insert (Root, Frame_1_1, F1);
      T.Assert (Root.Used > 0, "Insert must increment the root used count");
      MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      Insert (Root, Frame_1_2, F2);
      MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      Insert (Root, Frame_1_3, F3);
      MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Output, "Release frame F1");
      Release (F1);
      MAT.Frames.Print (Ada.Text_IO.Standard_Output, Root);
      T.Assert (F2.Used > 0, "Release must not change other frames");
      T.Assert (Root.Used > 0, "Release must not change root frame");
      Destroy (Root);
   end Test_Release_Frames;

end MAT.Frames.Tests;

Fix compilation of unit test

Fix compilation of unit test


-----------------------------------------------------------------------
--  druss-commands-status -- Druss status commands
--  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 Ada.Text_IO;
with Ada.Strings.Unbounded;
with Util.Properties;
with Druss.Gateways;
package body Druss.Commands.Status is

   use Ada.Text_IO;
   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Execute the wifi 'status' command to print the Wifi current status.
   --  ------------------------------
   procedure Do_Status (Command   : in Command_Type;
                        Args      : in Argument_List'Class;
                        Context   : in out Context_Type) is
      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;

      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type) is
      begin
         Gateway.Refresh;
         Console.Start_Row;
         Console.Print_Field (F_IP_ADDR, Gateway.Ip);
         Console.Print_Field (F_WAN_IP, Gateway.Wan.Get ("wan.ip.address", " "));
         Console.Print_Field (F_INTERNET, Gateway.Wan.Get ("wan.internet.state", " "));
         Console.Print_Field (F_VOIP, Gateway.Voip.Get ("voip.status", " "));
         Console.Print_Field (F_WIFI, Gateway.Wifi.Get ("wireless.radio.24.enable", " "));
         if not Gateway.Wifi.Exists ("wireless.radio.5.enable") then
            Console.Print_Field (F_WIFI5, "");
         else
            Console.Print_Field (F_WIFI5, Gateway.Wifi.Get ("wireless.radio.5.enable", " "));
         end if;
         Console.Print_Field (F_ENCRYPTION, Gateway.Wifi.Get ("wireless.ssid.24.security.encryption", " "));
         Console.End_Row;
      end Box_Status;

   begin
      Console.Start_Title;
      Console.Print_Title (F_IP_ADDR, "LAN IP", 15);
      Console.Print_Title (F_WAN_IP, "WAN IP", 15);
      Console.Print_Title (F_INTERNET, "Internet", 9);
      Console.Print_Title (F_VOIP, "VoIP", 6);
      Console.Print_Title (F_WIFI, "Wifi 2.4G", 10);
      Console.Print_Title (F_WIFI5, "Wifi 5G", 10);
      Console.Print_Title (F_ACCESS_CONTROL, "Parental", 10);
      Console.Print_Title (F_DYNDNS, "DynDNS", 10);
      Console.Print_Title (F_DEVICES, "Devices", 12);
      Console.End_Title;
      Druss.Gateways.Iterate (Context.Gateways, Box_Status'Access);
   end Do_Status;

   --  Execute a status command to report information about the Bbox.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Do_Status (Args, Context);
   end Execute;

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type) is
   begin
      Put_Line ("status: Control and get status about the Bbox Wifi");
      Put_Line ("Usage: wifi {<action>} [<parameters>]");
      New_Line;
      Put_Line ("  status [IP]...         Turn ON the wifi on the Bbox.");
      Put_Line ("  wifi off [IP]...        Turn OFF the wifi on the Bbox.");
      Put_Line ("  wifi show               Show information about the wifi on the Bbox.");
      Put_Line ("  wifi devices            Show the wifi devices which are connected.");
   end Help;

end Druss.Commands.Status;

-----------------------------------------------------------------------
--  druss-commands-status -- Druss status commands
--  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 Ada.Text_IO;
with Ada.Strings.Unbounded;
with Util.Properties;
with Util.Strings;
with Druss.Gateways;
package body Druss.Commands.Status is

   use Ada.Text_IO;
   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Execute the wifi 'status' command to print the Wifi current status.
   --  ------------------------------
   procedure Do_Status (Command   : in Command_Type;
                        Args      : in Argument_List'Class;
                        Context   : in out Context_Type) is
      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;
      N : Natural := 0;

      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type) is
      begin
         Gateway.Refresh;
         Console.Start_Row;
         Console.Print_Field (F_IP_ADDR, Gateway.Ip);
         Console.Print_Field (F_WAN_IP, Gateway.Wan.Get ("wan.ip.address", " "));
         Print_Status (Console, F_INTERNET, Gateway.Wan.Get ("wan.internet.state", " "));
         Console.Print_Field (F_VOIP, Gateway.Voip.Get ("voip.status", " "));
         Print_On_Off (Console, F_WIFI, Gateway.Wifi.Get ("wireless.radio.24.enable", " "));
         if not Gateway.Wifi.Exists ("wireless.radio.5.enable") then
            Console.Print_Field (F_WIFI5, "");
         else
            Print_On_Off (Console, F_WIFI5, Gateway.Wifi.Get ("wireless.radio.5.enable", " "));
         end if;
         Console.Print_Field (F_ACCESS_CONTROL, Gateway.IPtv.Get ("iptv.0.address", "x"));
         Console.End_Row;
         N := N + 1;
         Gateway.IPtv.Save_Properties ("iptv" & Util.Strings.Image (N) & ".properties");
      end Box_Status;

   begin
      Console.Start_Title;
      Console.Print_Title (F_IP_ADDR, "LAN IP", 15);
      Console.Print_Title (F_WAN_IP, "WAN IP", 15);
      Console.Print_Title (F_INTERNET, "Internet", 9);
      Console.Print_Title (F_VOIP, "VoIP", 6);
      Console.Print_Title (F_WIFI, "Wifi 2.4G", 10);
      Console.Print_Title (F_WIFI5, "Wifi 5G", 10);
      Console.Print_Title (F_ACCESS_CONTROL, "Parental", 10);
      Console.Print_Title (F_DYNDNS, "DynDNS", 10);
      Console.Print_Title (F_DEVICES, "Devices", 12);
      Console.End_Title;
      Druss.Gateways.Iterate (Context.Gateways, Box_Status'Access);
   end Do_Status;

   --  Execute a status command to report information about the Bbox.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Do_Status (Args, Context);
   end Execute;

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type) is
   begin
      Put_Line ("status: Control and get status about the Bbox Wifi");
      Put_Line ("Usage: wifi {<action>} [<parameters>]");
      New_Line;
      Put_Line ("  status [IP]...         Turn ON the wifi on the Bbox.");
      Put_Line ("  wifi off [IP]...        Turn OFF the wifi on the Bbox.");
      Put_Line ("  wifi show               Show information about the wifi on the Bbox.");
      Put_Line ("  wifi devices            Show the wifi devices which are connected.");
   end Help;

end Druss.Commands.Status;

Update the status command to print more information


-----------------------------------------------------------------------
--  security-auth-oauth -- OAuth based authentication
--  Copyright (C) 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 Security.OAuth.Clients;
private package Security.Auth.OAuth is

   --  ------------------------------
   --  OAuth Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OAuth authorization process.
   type Manager is abstract new Security.Auth.Manager with private;

   --  Initialize the authentication realm.
   overriding
   procedure Initialize (Realm     : in out Manager;
                         Params    : in Parameters'Class;
                         Provider  : in String := PROVIDER_OPENID);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   --  (See OpenID Section 7.3 Discovery)
   overriding
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   overriding
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   overriding
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   overriding
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the OAuth access token and retrieve information about the user.
   procedure Verify_Access_Token (Realm   : in Manager;
                                  Assoc   : in Association;
                                  Request : in Parameters'Class;
                                  Token   : in Security.OAuth.Clients.Access_Token_Access;
                                  Result  : in out Authentication) is abstract;

private

   type Manager is abstract new Security.Auth.Manager with record
      Return_To : Unbounded_String;
      Realm     : Unbounded_String;
      Scope     : Unbounded_String;
      App       : Security.OAuth.Clients.Application;
   end record;

end Security.Auth.OAuth;

-----------------------------------------------------------------------
--  security-auth-oauth -- OAuth based authentication
--  Copyright (C) 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 Security.OAuth.Clients;
private package Security.Auth.OAuth is

   --  ------------------------------
   --  OAuth Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OAuth authorization process.
   type Manager is abstract new Security.Auth.Manager with private;

   --  Initialize the authentication realm.
   overriding
   procedure Initialize (Realm     : in out Manager;
                         Params    : in Parameters'Class;
                         Provider  : in String := PROVIDER_OPENID);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   --  (See OpenID Section 7.3 Discovery)
   overriding
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   overriding
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   overriding
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   overriding
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the OAuth access token and retrieve information about the user.
   procedure Verify_Access_Token (Realm   : in Manager;
                                  Assoc   : in Association;
                                  Request : in Parameters'Class;
                                  Token   : in Security.OAuth.Clients.Access_Token_Access;
                                  Result  : in out Authentication) is abstract;

private

   type Manager is abstract new Security.Auth.Manager with record
      Return_To : Unbounded_String;
      Realm     : Unbounded_String;
      Scope     : Unbounded_String;
      App       : Security.OAuth.Clients.Application;
   end record;

end Security.Auth.OAuth;

Add some comment

Add some comment


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

with Ada.Strings.Hash;

--  The Locales package defines the Locale type to represent
--  the language, country and variant.
--
--  The language is a valid ISO language code.  This is a two-letter
--  lower case code defined by IS-639
--  See http://www.loc.gov/standards/iso639-2/englangn.html
--
--  The country is a valid ISO country code.  These codes are
--  a two letter upper-case code defined by ISO-3166.
--  See http://www.iso.ch/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1.html
--
--  The variant part is a vendor or browser specific code.
--
--  The Locales package tries to follow the Java Locale class.
package body Util.Locales is

   --  ------------------------------
   --  Get the lowercase two-letter ISO-639 code.
   --  ------------------------------
   function Get_Language (Loc : in Locale) return String is
   begin
      if Loc = null then
         return "";
      else
         return Loc (1 .. 2);
      end if;
   end Get_Language;

   --  ------------------------------
   --  Get the ISO 639-2 language code.
   --  ------------------------------
   function Get_ISO3_Language (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 3 then
         return "";
      end if;
      if Loc'Length <= 6 then
         return Loc (4 .. 6);
      end if;
      return Loc (7 .. 9);
   end Get_ISO3_Language;

   --  ------------------------------
   --  Get the uppercase two-letter ISO-3166 code.
   --  ------------------------------
   function Get_Country (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 2 or else Loc (3) /= '_' then
         return "";
      else
         return Loc (4 .. 5);
      end if;
   end Get_Country;

   --  ------------------------------
   --  Get the ISO-3166-2 country code.
   --  ------------------------------
   function Get_ISO3_Country (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 5 then
         return "";
      else
         return Loc (10 .. Loc'Last);
      end if;
   end Get_ISO3_Country;

   --  ------------------------------
   --  Get the variant code
   --  ------------------------------
   function Get_Variant (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 13 then
         return "";
      else
         return Loc (7 .. 8);
      end if;
   end Get_Variant;

   --  ------------------------------
   --  Get the locale for the given language code
   --  ------------------------------
   function Get_Locale (Language : in String) return Locale is
      Length : constant Natural := Language'Length;
      Lower  : Natural := Locales'First;
      Upper  : Natural := Locales'Last;
      Pos    : Natural;
      Result : Locale;
   begin
      while Lower <= Upper loop
         Pos := (Lower + Upper) / 2;
         Result := Locales (Pos);
         if Result'Length < Length then
            if Result.all < Language (Language'First .. Language'First + Result'Length - 1) then
               Lower := Pos + 1;
            else
               Upper := Pos - 1;
            end if;
         elsif Result'Length > Length and then Result (Length + 1) = '.'
           and then Result (1 .. Length) = Language
         then
            return Result;
         elsif Result (1 .. Length) < Language then
            Lower := Pos + 1;
         else
            Upper := Pos - 1;
         end if;
      end loop;
      return NULL_LOCALE;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale for the given language and country code
   --  ------------------------------
   function Get_Locale (Language : in String;
                        Country  : in String) return Locale is
   begin
      if Language'Length /= 2 or else (Country'Length /= 0 and Country'Length /= 2) then
         return NULL_LOCALE;
      elsif Country'Length = 0 then
         return Get_Locale (Language);
      else
         return Get_Locale (Language & "_" & Country);
      end if;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale for the given language, country and variant code
   --  ------------------------------
   function Get_Locale (Language : in String;
                        Country  : in String;
                        Variant  : in String) return Locale is
   begin
      if Language'Length /= 2
        or else (Country'Length /= 0 and Country'Length /= 2)
        or else (Variant'Length /= 0 and Variant'Length /= 2)
      then
         return NULL_LOCALE;
      end if;
      if Country'Length = 0 and Variant'Length = 0 then
         return Get_Locale (Language);
      elsif Variant'Length = 0 then
         return Get_Locale (Language, Country);
      else
         return Get_Locale (Language & "_" & Country & "_" & Variant);
      end if;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale code in the form language_country_variant.
   --  ------------------------------
   function To_String (Loc : in Locale) return String is
   begin
      if Loc = null then
         return "";
      elsif Loc'Length > 3 and Loc (3) = '.' then
         return Loc (1 .. 2);
      elsif Loc'Length > 6 and Loc (6) = '.' then
         return Loc (1 .. 5);
      else
         return Loc (1 .. 8);
      end if;
   end To_String;

   --  ------------------------------
   --  Compute the hash value of the locale.
   --  ------------------------------
   function Hash (Loc : in Locale) return Ada.Containers.Hash_Type is
      use type Ada.Containers.Hash_Type;
   begin
      return Ada.Strings.Hash (Loc.all);
   end Hash;

end Util.Locales;

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

with Ada.Strings.Hash;

package body Util.Locales is

   --  ------------------------------
   --  Get the lowercase two-letter ISO-639 code.
   --  ------------------------------
   function Get_Language (Loc : in Locale) return String is
   begin
      if Loc = null then
         return "";
      else
         return Loc (1 .. 2);
      end if;
   end Get_Language;

   --  ------------------------------
   --  Get the ISO 639-2 language code.
   --  ------------------------------
   function Get_ISO3_Language (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 3 then
         return "";
      end if;
      if Loc'Length <= 6 then
         return Loc (4 .. 6);
      end if;
      return Loc (7 .. 9);
   end Get_ISO3_Language;

   --  ------------------------------
   --  Get the uppercase two-letter ISO-3166 code.
   --  ------------------------------
   function Get_Country (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 2 or else Loc (3) /= '_' then
         return "";
      else
         return Loc (4 .. 5);
      end if;
   end Get_Country;

   --  ------------------------------
   --  Get the ISO-3166-2 country code.
   --  ------------------------------
   function Get_ISO3_Country (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 5 then
         return "";
      else
         return Loc (10 .. Loc'Last);
      end if;
   end Get_ISO3_Country;

   --  ------------------------------
   --  Get the variant code
   --  ------------------------------
   function Get_Variant (Loc : in Locale) return String is
   begin
      if Loc = null or else Loc'Length <= 13 then
         return "";
      else
         return Loc (7 .. 8);
      end if;
   end Get_Variant;

   --  ------------------------------
   --  Get the locale for the given language code
   --  ------------------------------
   function Get_Locale (Language : in String) return Locale is
      Length : constant Natural := Language'Length;
      Lower  : Natural := Locales'First;
      Upper  : Natural := Locales'Last;
      Pos    : Natural;
      Result : Locale;
   begin
      while Lower <= Upper loop
         Pos := (Lower + Upper) / 2;
         Result := Locales (Pos);
         if Result'Length < Length then
            if Result.all < Language (Language'First .. Language'First + Result'Length - 1) then
               Lower := Pos + 1;
            else
               Upper := Pos - 1;
            end if;
         elsif Result'Length > Length and then Result (Length + 1) = '.'
           and then Result (1 .. Length) = Language
         then
            return Result;
         elsif Result (1 .. Length) < Language then
            Lower := Pos + 1;
         else
            Upper := Pos - 1;
         end if;
      end loop;
      return NULL_LOCALE;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale for the given language and country code
   --  ------------------------------
   function Get_Locale (Language : in String;
                        Country  : in String) return Locale is
   begin
      if Language'Length /= 2 or else (Country'Length /= 0 and Country'Length /= 2) then
         return NULL_LOCALE;
      elsif Country'Length = 0 then
         return Get_Locale (Language);
      else
         return Get_Locale (Language & "_" & Country);
      end if;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale for the given language, country and variant code
   --  ------------------------------
   function Get_Locale (Language : in String;
                        Country  : in String;
                        Variant  : in String) return Locale is
   begin
      if Language'Length /= 2
        or else (Country'Length /= 0 and Country'Length /= 2)
        or else (Variant'Length /= 0 and Variant'Length /= 2)
      then
         return NULL_LOCALE;
      end if;
      if Country'Length = 0 and Variant'Length = 0 then
         return Get_Locale (Language);
      elsif Variant'Length = 0 then
         return Get_Locale (Language, Country);
      else
         return Get_Locale (Language & "_" & Country & "_" & Variant);
      end if;
   end Get_Locale;

   --  ------------------------------
   --  Get the locale code in the form language_country_variant.
   --  ------------------------------
   function To_String (Loc : in Locale) return String is
   begin
      if Loc = null then
         return "";
      elsif Loc'Length > 3 and Loc (3) = '.' then
         return Loc (1 .. 2);
      elsif Loc'Length > 6 and Loc (6) = '.' then
         return Loc (1 .. 5);
      else
         return Loc (1 .. 8);
      end if;
   end To_String;

   --  ------------------------------
   --  Compute the hash value of the locale.
   --  ------------------------------
   function Hash (Loc : in Locale) return Ada.Containers.Hash_Type is
      use type Ada.Containers.Hash_Type;
   begin
      return Ada.Strings.Hash (Loc.all);
   end Hash;

end Util.Locales;

Fix header style

Fix header style


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

   --  use Util.Log;
   use type Util.Log.Loggers.Logger_Access;

   --  The logger'
   Log : aliased constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Serialize.IO",
                                                                              Util.Log.WARN_LEVEL);
   procedure Write_Attribute (Stream : in out Output_Stream'Class;
                              Name   : in String;
                              Value  : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Stream.Write_Attribute (Name, Ada.Strings.Unbounded.To_String (Value));
   end Write_Attribute;

   procedure Write_Entity (Stream : in out Output_Stream'Class;
                           Name   : in String;
                           Value  : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Stream.Write_Entity (Name, Ada.Strings.Unbounded.To_String (Value));
   end Write_Entity;

   --  ------------------------------
   --  Read the file and parse it using the JSON parser.
   --  ------------------------------
   procedure Parse (Handler : in out Parser;
                    File    : in String) is
      Stream     : aliased Util.Streams.Files.File_Stream;
      Buffer     : Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Handler.Error_Logger.Info ("Reading file {0}", File);

      Handler.File := Ada.Strings.Unbounded.To_Unbounded_String (File);
      Buffer.Initialize (Output => null,
                         Input  => Stream'Unchecked_Access,
                         Size   => 1024);
      Stream.Open (Mode => Ada.Streams.Stream_IO.In_File, Name => File);
      Context_Stack.Clear (Handler.Stack);
      Parser'Class (Handler).Parse (Buffer);

   exception
      when Util.Serialize.Mappers.Field_Fatal_Error =>
         null;

      when Ada.IO_Exceptions.Name_Error =>
         Parser'Class (Handler).Error ("File '" & File & "' does not exist.");

      when E : others =>
         Parser'Class (Handler).Error ("Exception " & Ada.Exceptions.Exception_Name (E));
   end Parse;

   --  ------------------------------
   --  Parse the content string.
   --  ------------------------------
   procedure Parse_String (Handler : in out Parser;
                           Content : in String) is
      Stream : aliased Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Handler.File := Ada.Strings.Unbounded.To_Unbounded_String ("<inline>");
      Stream.Initialize (Content  => Content);
      Context_Stack.Clear (Handler.Stack);
      Parser'Class (Handler).Parse (Stream);

   exception
      when Util.Serialize.Mappers.Field_Fatal_Error =>
         null;

      when E : others =>
         Parser'Class (Handler).Error ("Exception " & Ada.Exceptions.Exception_Name (E));
   end Parse_String;

   --  ------------------------------
   --  Returns true if the Parse operation detected at least one error.
   --  ------------------------------
   function Has_Error (Handler : in Parser) return Boolean is
   begin
      return Handler.Error_Flag;
   end Has_Error;

   --  ------------------------------
   --  Set the error logger to report messages while parsing and reading the input file.
   --  ------------------------------
   procedure Set_Logger (Handler : in out Parser;
                         Logger  : in Util.Log.Loggers.Logger_Access) is
   begin
      Handler.Error_Logger := Logger;
   end Set_Logger;

   --  ------------------------------
   --  Push the current context when entering in an element.
   --  ------------------------------
   procedure Push (Handler : in out Parser) is
      use type Util.Serialize.Mappers.Mapper_Access;
   begin
      Context_Stack.Push (Handler.Stack);
   end Push;

   --  ------------------------------
   --  Pop the context and restore the previous context when leaving an element
   --  ------------------------------
   procedure Pop (Handler  : in out Parser) is
   begin
      Context_Stack.Pop (Handler.Stack);
   end Pop;

   function Find_Mapper (Handler : in Parser;
                         Name    : in String) return Util.Serialize.Mappers.Mapper_Access is
      pragma Unreferenced (Handler, Name);
   begin
      return null;
   end Find_Mapper;

   --  ------------------------------
   --  Start a new object associated with the given name.  This is called when
   --  the '{' is reached.  The reader must be updated so that the next
   --  Set_Member procedure will associate the name/value pair on the
   --  new object.
   --  ------------------------------
   procedure Start_Object (Handler : in out Parser;
                           Name    : in String) is

      use type Util.Serialize.Mappers.Mapper_Access;

      Current : constant Element_Context_Access := Context_Stack.Current (Handler.Stack);
      Next    : Element_Context_Access;
      Pos     : Positive;
   begin
      Log.Debug ("Start object {0}", Name);

      Context_Stack.Push (Handler.Stack);
      Next := Context_Stack.Current (Handler.Stack);
      if Current /= null then
         Pos := 1;

         --  Notify we are entering in the given node for each active mapping.
         for I in Current.Active_Nodes'Range loop
            declare
               Node  : constant Mappers.Mapper_Access := Current.Active_Nodes (I);
               Child : Mappers.Mapper_Access;
            begin
               exit when Node = null;
               Child := Node.Find_Mapper (Name => Name);
               if Child = null and then Node.Is_Wildcard then
                  Child := Node;
               end if;
               if Child /= null then
                  Log.Debug ("{0} is matching {1}", Name, Child.Get_Name);
                  Child.Start_Object (Handler, Name);
                  Next.Active_Nodes (Pos) := Child;
                  Pos := Pos + 1;
               end if;
            end;
         end loop;
         while Pos <= Next.Active_Nodes'Last loop
            Next.Active_Nodes (Pos) := null;
            Pos := Pos + 1;
         end loop;
      else
         Next.Active_Nodes (1) := Handler.Mapping_Tree.Find_Mapper (Name);
      end if;
   end Start_Object;

   --  ------------------------------
   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   --  ------------------------------
   procedure Finish_Object (Handler : in out Parser;
                            Name    : in String) is

      use type Util.Serialize.Mappers.Mapper_Access;
   begin
      Log.Debug ("Finish object {0}", Name);

      declare
         Current : constant Element_Context_Access := Context_Stack.Current (Handler.Stack);
      begin
         if Current /= null then
            --  Notify we are leaving the given node for each active mapping.
            for I in Current.Active_Nodes'Range loop
               declare
                  Node : constant Mappers.Mapper_Access := Current.Active_Nodes (I);
               begin
                  exit when Node = null;
                  Node.Finish_Object (Handler, Name);
               end;
            end loop;
         end if;
      end;
      Handler.Pop;
   end Finish_Object;

   procedure Start_Array (Handler : in out Parser;
                          Name    : in String) is
      pragma Unreferenced (Name);
   begin
      Handler.Push;
   end Start_Array;

   procedure Finish_Array (Handler : in out Parser;
                           Name    : in String;
                           Count   : in Natural) is
      pragma Unreferenced (Name, Count);
   begin
      Handler.Pop;
   end Finish_Array;

   --  -----------------------
   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   --  -----------------------
   procedure Set_Member (Handler   : in out Parser;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False) is
      use Util.Serialize.Mappers;

      Current : constant Element_Context_Access := Context_Stack.Current (Handler.Stack);
   begin
      Log.Debug ("Set member {0}", Name);

      if Current /= null then

         --  Look each active mapping node.
         for I in Current.Active_Nodes'Range loop
            declare
               Node : constant Mapper_Access := Current.Active_Nodes (I);
            begin
               exit when Node = null;
               Node.Set_Member (Name      => Name,
                                Value     => Value,
                                Attribute => Attribute,
                                Context   => Handler);

            exception
               when E : Util.Serialize.Mappers.Field_Error =>
                  Parser'Class (Handler).Error (Message => Ada.Exceptions.Exception_Message (E));

               when E : Util.Serialize.Mappers.Field_Fatal_Error =>
                  Parser'Class (Handler).Error (Message => Ada.Exceptions.Exception_Message (E));
                  raise;

                  --  For other exception, report an error with the field name and value.
               when E : others =>
                  Parser'Class (Handler).Error (Message => "Cannot set field '" & Name & "' to '"
                                                & Util.Beans.Objects.To_String (Value) & "': "
                                                & Ada.Exceptions.Exception_Message (E));
                  raise;
            end;
         end loop;
      end if;
   end Set_Member;

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   function Get_Location (Handler : in Parser) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Handler.File);
   end Get_Location;

   --  ------------------------------
   --  Report an error while parsing the input stream.  The error message will be reported
   --  on the logger associated with the parser.  The parser will be set as in error so that
   --  the Has_Error function will return True after parsing the whole file.
   --  ------------------------------
   procedure Error (Handler : in out Parser;
                    Message : in String) is
   begin
      Handler.Error_Logger.Error ("{0}: {1}",
                                  Parser'Class (Handler).Get_Location,
                                  Message);
      Handler.Error_Flag := True;
   end Error;

   procedure Add_Mapping (Handler : in out Parser;
                          Path    : in String;
                          Mapper  : in Util.Serialize.Mappers.Mapper_Access) is
   begin
      Handler.Mapping_Tree.Add_Mapping (Path, Mapper);
   end Add_Mapping;

   --  ------------------------------
   --  Dump the mapping tree on the logger using the INFO log level.
   --  ------------------------------
   procedure Dump (Handler : in Parser'Class;
                   Logger  : in Util.Log.Loggers.Logger'Class) is
   begin
      Util.Serialize.Mappers.Dump (Handler.Mapping_Tree, Logger, "Mapping ");
   end Dump;

end Util.Serialize.IO;

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

   --  use Util.Log;
   use type Util.Log.Loggers.Logger_Access;

   --  The logger'
   Log : aliased constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Serialize.IO",
                                                                              Util.Log.WARN_LEVEL);
   procedure Write_Attribute (Stream : in out Output_Stream'Class;
                              Name   : in String;
                              Value  : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Stream.Write_Attribute (Name, Ada.Strings.Unbounded.To_String (Value));
   end Write_Attribute;

   procedure Write_Entity (Stream : in out Output_Stream'Class;
                           Name   : in String;
                           Value  : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Stream.Write_Entity (Name, Ada.Strings.Unbounded.To_String (Value));
   end Write_Entity;

   --  ------------------------------
   --  Read the file and parse it using the JSON parser.
   --  ------------------------------
   procedure Parse (Handler : in out Parser;
                    File    : in String;
                    Sink    : in out Reader'Class) is
      Stream     : aliased Util.Streams.Files.File_Stream;
      Buffer     : Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Handler.Error_Logger.Info ("Reading file {0}", File);

      Handler.File := Ada.Strings.Unbounded.To_Unbounded_String (File);
      Buffer.Initialize (Output => null,
                         Input  => Stream'Unchecked_Access,
                         Size   => 1024);
      Stream.Open (Mode => Ada.Streams.Stream_IO.In_File, Name => File);
      --  Context_Stack.Clear (Handler.Stack);
      Parser'Class (Handler).Parse (Buffer, Sink);

   exception
--      when Util.Serialize.Mappers.Field_Fatal_Error =>
--         null;

      when Ada.IO_Exceptions.Name_Error =>
         Parser'Class (Handler).Error ("File '" & File & "' does not exist.");

      when E : others =>
         if not Handler.Error_Flag then
            Parser'Class (Handler).Error ("Exception " & Ada.Exceptions.Exception_Name (E));
         end if;
   end Parse;

   --  ------------------------------
   --  Parse the content string.
   --  ------------------------------
   procedure Parse_String (Handler : in out Parser;
                           Content : in String;
                           Sink    : in out Reader'Class) is
      Stream : aliased Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Handler.File := Ada.Strings.Unbounded.To_Unbounded_String ("<inline>");
      Stream.Initialize (Content  => Content);
      --  Context_Stack.Clear (Handler.Stack);
      Parser'Class (Handler).Parse (Stream, Sink);

   exception
--      when Util.Serialize.Mappers.Field_Fatal_Error =>
--         null;

      when E : others =>
         if not Handler.Error_Flag then
            Parser'Class (Handler).Error ("Exception " & Ada.Exceptions.Exception_Name (E));
         end if;

   end Parse_String;

   --  ------------------------------
   --  Returns true if the Parse operation detected at least one error.
   --  ------------------------------
   function Has_Error (Handler : in Parser) return Boolean is
   begin
      return Handler.Error_Flag;
   end Has_Error;

   --  ------------------------------
   --  Set the error logger to report messages while parsing and reading the input file.
   --  ------------------------------
   procedure Set_Logger (Handler : in out Parser;
                         Logger  : in Util.Log.Loggers.Logger_Access) is
   begin
      Handler.Error_Logger := Logger;
   end Set_Logger;

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   function Get_Location (Handler : in Parser) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Handler.File);
   end Get_Location;

   --  ------------------------------
   --  Report an error while parsing the input stream.  The error message will be reported
   --  on the logger associated with the parser.  The parser will be set as in error so that
   --  the Has_Error function will return True after parsing the whole file.
   --  ------------------------------
   procedure Error (Handler : in out Parser;
                    Message : in String) is
   begin
      Handler.Error_Logger.Error ("{0}: {1}",
                                  Parser'Class (Handler).Get_Location,
                                  Message);
      Handler.Error_Flag := True;
   end Error;

end Util.Serialize.IO;

Move the Start_Object, Finish_Object, Start_Array, End_Array, Push Pop, Set_Member operations to the Mappers package Use the Reader interface object


-----------------------------------------------------------------------
--  wiki-nodes -- Wiki Document Internal representation
--  Copyright (C) 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.Unchecked_Deallocation;
package body Wiki.Nodes is

   --  ------------------------------
   --  Append a node to the tag node.
   --  ------------------------------
   procedure Append (Into : in Node_Type_Access;
                     Node : in Node_Type_Access) is
   begin
      if Into.Children = null then
         Into.Children := new Node_List;
         Into.Children.Current := Into.Children.First'Access;
      end if;
      Append (Into.Children.all, Node);
   end Append;

   --  ------------------------------
   --  Append a node to the node list.
   --  ------------------------------
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access) is
      Block : Node_List_Block_Access := Into.Current;
   begin
      if Block.Last = Block.Max then
         Block.Next := new Node_List_Block (Block.Max * 2);
         Block := Block.Next;
         Into.Current := Block;
      end if;
      Block.Last := Block.Last + 1;
      Block.List (Block.Last) := Node;
      Into.Length := Into.Length + 1;
   end Append;

   --  ------------------------------
   --  Finalize the node list to release the allocated memory.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Node_List) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Node_List_Block, Node_List_Block_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Node_Type, Node_Type_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Node_List, Node_List_Access);

      procedure Release (List : in Node_List_Block_Access);
      procedure Free_Block (Block : in out Node_List_Block);

      procedure Free_Block (Block : in out Node_List_Block) is
      begin
         for I in 1 .. Block.Last loop
            if Block.List (I).Kind = N_TAG_START and then Block.List (I).Children /= null then
               Finalize (Block.List (I).Children.all);
               Free (Block.List (I).Children);
            end if;
            Free (Block.List (I));
         end loop;
      end Free_Block;

      procedure Release (List : in Node_List_Block_Access) is
         Next  : Node_List_Block_Access := List;
         Block : Node_List_Block_Access;
      begin
         while Next /= null loop
            Block := Next;
            Free_Block (Block.all);
            Next := Next.Next;
            Free (Block);
         end loop;
      end Release;

   begin
      Release (List.First.Next);
      Free_Block (List.First);
   end Finalize;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (List    : in Node_List_Access;
                      Process : not null access procedure (Node : in Node_Type)) is
      Block : Node_List_Block_Access := List.First'Access;
   begin
      loop
         for I in 1 .. Block.Last loop
            Process (Block.List (I).all);
         end loop;
         Block := Block.Next;
         exit when Block = null;
      end loop;
   end Iterate;

   --  ------------------------------
   --  Append a node to the node list.
   --  ------------------------------
   procedure Append (Into : in out Node_List_Ref;
                     Node : in Node_Type_Access) is
   begin
      if Into.Is_Null then
         Node_List_Refs.Ref (Into) := Node_List_Refs.Create;
         Into.Value.Current := Into.Value.First'Access;
      end if;
      Append (Into.Value.all, Node);
   end Append;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (List    : in Node_List_Ref;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      if not List.Is_Null then
         Iterate (List.Value, Process);
      end if;
   end Iterate;

   --  ------------------------------
   --  Returns True if the list reference is empty.
   --  ------------------------------
   function Is_Empty (List : in Node_List_Ref) return Boolean is
   begin
      return List.Is_Null;
   end Is_Empty;

   --  ------------------------------
   --  Get the number of nodes in the list.
   --  ------------------------------
   function Length (List : in Node_List_Ref) return Natural is
   begin
      if List.Is_Null then
         return 0;
      else
         return List.Value.Length;
      end if;
   end Length;

end Wiki.Nodes;

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

   --  ------------------------------
   --  Append a node to the tag node.
   --  ------------------------------
   procedure Append (Into : in Node_Type_Access;
                     Node : in Node_Type_Access) is
   begin
      if Into.Children = null then
         Into.Children := new Node_List;
         Into.Children.Current := Into.Children.First'Access;
      end if;
      Append (Into.Children.all, Node);
   end Append;

   --  ------------------------------
   --  Append a node to the node list.
   --  ------------------------------
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access) is
      Block : Node_List_Block_Access := Into.Current;
   begin
      if Block.Last = Block.Max then
         Block.Next := new Node_List_Block (Block.Max * 2);
         Block := Block.Next;
         Into.Current := Block;
      end if;
      Block.Last := Block.Last + 1;
      Block.List (Block.Last) := Node;
      Into.Length := Into.Length + 1;
   end Append;

   --  ------------------------------
   --  Finalize the node list to release the allocated memory.
   --  ------------------------------
   procedure Finalize (List : in out Node_List) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Node_List_Block, Node_List_Block_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Node_Type, Node_Type_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Node_List, Node_List_Access);

      procedure Release (List : in Node_List_Block_Access);
      procedure Free_Block (Block : in out Node_List_Block);

      procedure Free_Block (Block : in out Node_List_Block) is
      begin
         for I in 1 .. Block.Last loop
            if Block.List (I).Kind = N_TAG_START and then Block.List (I).Children /= null then
               Finalize (Block.List (I).Children.all);
               Free (Block.List (I).Children);
            end if;
            Free (Block.List (I));
         end loop;
      end Free_Block;

      procedure Release (List : in Node_List_Block_Access) is
         Next  : Node_List_Block_Access := List;
         Block : Node_List_Block_Access;
      begin
         while Next /= null loop
            Block := Next;
            Free_Block (Block.all);
            Next := Next.Next;
            Free (Block);
         end loop;
      end Release;

   begin
      Release (List.First.Next);
      Free_Block (List.First);
   end Finalize;

end Wiki.Nodes;

Refactor Node_List and references to use Ada Util general references


-----------------------------------------------------------------------
--  wiki -- Ada Wiki Engine
--  Copyright (C) 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 Wiki.Attributes;
with Wiki.Strings;
with Ada.Finalization;
with Util.Refs;
package Wiki.Nodes is

   pragma Preelaborate;

   subtype WString is Wide_Wide_String;

   type Node_Kind is (N_LINE_BREAK,
                      N_HORIZONTAL_RULE,
                      N_PARAGRAPH,
                      N_HEADER,
                      N_BLOCKQUOTE,
                      N_QUOTE,
                      N_TAG_START,
                      N_PREFORMAT,
                      N_INDENT,
                      N_TEXT,
                      N_LINK,
                      N_IMAGE);

   --  Node kinds which are simple markers in the document.
   subtype Simple_Node_Kind is Node_Kind range N_LINE_BREAK .. N_PARAGRAPH;

     --  The possible HTML tags as described in HTML5 specification.
   type Html_Tag_Type is
     (
      --  Section 4.1 The root element
      HTML_TAG,

      --  Section 4.2 Document metadata
      HEAD_TAG, TITLE_TAG, BASE_TAG, LINK_TAG, META_TAG, STYLE_TAG,

      --  Section 4.3 Sections
      BODY_TAG, ARTICLE_TAG, SECTION_TAG, NAV_TAG, ASIDE_TAG,
      H1_TAG, H2_TAG, H3_TAG, H4_TAG, H5_TAG, H6_TAG,
      HEADER_TAG, FOOTER_TAG,
      ADDRESS_TAG,

      --  Section 4.4 Grouping content
      P_TAG, HR_TAG, PRE_TAG, BLOCKQUOTE_TAG,
      OL_TAG, UL_TAG, LI_TAG,
      DL_TAG, DT_TAG, DD_TAG,
      FIGURE_TAG, FIGCAPTION_TAG,
      DIV_TAG, MAIN_TAG,

      --  Section 4.5 Text-level semantics
      A_TAG, EM_TAG, STRONG_TAG, SMALL_TAG,
      S_TAG, CITE_TAG, Q_TAG, DFN_TAG, ABBR_TAG,
      DATA_TAG, TIME_TAG, CODE_TAG, VAR_TAG, SAMP_TAG,
      KBD_TAG, SUB_TAG, SUP_TAG,
      I_TAG, B_TAG, U_TAG,
      MARK_TAG, RUBY_TAG, RB_TAG, RT_TAG, RTC_TAG,
      RP_TAG, BDI_TAG, BDO_TAG, SPAN_TAG,
      BR_TAG, WBR_TAG,

      --  Section 4.6 Edits
      INS_TAG, DEL_TAG,

      --  Section 4.7 Embedded content
      IMG_TAG,
      IFRAME_TAG,
      EMBED_TAG,
      OBJECT_TAG,
      PARAM_TAG,
      VIDEO_TAG,
      AUDIO_TAG,
      SOURCE_TAG,
      TRACK_TAG,
      MAP_TAG,
      AREA_TAG,

      --  Section 4.9 Tabular data
      TABLE_TAG, CAPTION_TAG, COLGROUP_TAG, COL_TAG,
      TBODY_TAG, THEAD_TAG, TFOOT_TAG,
      TR_TAG, TD_TAG, TH_TAG,

      --  Section 4.10 Forms
      FORM_TAG, LABEL_TAG, INPUT_TAG,
      BUTTON_TAG, SELECT_TAG, DATALIST_TAG, OPTGROUP_TAG,
      OPTION_TAG, TEXTAREA_TAG, KEYGEN_TAG, OUTPUT_TAG,
      PROGRESS_TAG, METER_TAG, FIELDSET_TAG, LEGEND_TAG,

      --  Section 4.11 Scripting
      SCRIPT_TAG, NOSCRIPT_TAG,
      TEMPLATE_TAG, CANVAS_TAG,

      --  Unknown tags
      UNKNOWN_TAG
     );

   --  Find the tag from the tag name.
   function Find_Tag (Name : in Wide_Wide_String) return Html_Tag_Type;

   type String_Access is access constant String;

   --  Get the HTML tag name.
   function Get_Tag_Name (Tag : in Html_Tag_Type) return String_Access;

   type Node_List is limited private;
   type Node_List_Access is access all Node_List;

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Node_Kind; Len : Natural) is limited record
      case Kind is
         when N_HEADER | N_BLOCKQUOTE | N_INDENT =>
            Level  : Natural := 0;
            Header : WString (1 .. Len);

         when N_TEXT =>
            Format : Format_Map;
            Text   : WString (1 .. Len);

         when N_LINK | N_IMAGE | N_QUOTE =>
            Link_Attr  : Wiki.Attributes.Attribute_List_Type;
            Title      : WString (1 .. Len);

         when N_TAG_START =>
            Tag_Start  : Html_Tag_Type;
            Attributes : Wiki.Attributes.Attribute_List_Type;
            Children   : Node_List_Access;
            Parent     : Node_Type_Access;

         when N_PREFORMAT =>
            Preformatted : WString (1 .. Len);

         when others =>
            null;

      end case;
   end record;

   type Document is tagged private;

   --  Append a node to the document.
   procedure Append (Into : in out Document;
                     Node : in Node_Type_Access);

   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind);

   --  Append a HTML tag start node to the document.
   procedure Push_Node (Document   : in out Wiki.Nodes.Document;
                        Tag        : in Html_Tag_Type;
                        Attributes : in Wiki.Attributes.Attribute_List_Type);

   --  Pop the HTML tag.
   procedure Pop_Node (Document : in out Wiki.Nodes.Document;
                       Tag      : in Html_Tag_Type);

   --  Append the text with the given format at end of the document.
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map);

   --  Append a section header at end of the document.
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive);

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

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

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

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

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

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

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (List    : in Node_List_Access;
                      Process : not null access procedure (Node : in Node_Type));

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type));

private

   NODE_LIST_BLOCK_SIZE : constant Positive := 20;

   type Node_Array is array (Positive range <>) of Node_Type_Access;

   type Node_List_Block;
   type Node_List_Block_Access is access all Node_List_Block;

   type Node_List_Block (Max : Positive) is limited record
      Next  : Node_List_Block_Access;
      Last  : Natural := 0;
      List  : Node_Array (1 .. Max);
   end record;

   type Node_List is limited new Util.Refs.Ref_Entity with record
      Current : Node_List_Block_Access;
      Length  : Natural := 0;
      First   : aliased Node_List_Block (NODE_LIST_BLOCK_SIZE);
   end record;

   --  Append a node to the node list.
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access);

   package Node_List_Refs is new Util.Refs.References (Node_List, Node_List_Access);

   subtype Node_List_Ref is  Node_List_Refs.Ref;

   type Document is new Ada.Finalization.Controlled with record
      Nodes   : Node_List_Ref;
      Current : Node_Type_Access;
   end record;

   overriding
   procedure Initialize (Doc : in out Document);

end Wiki.Nodes;

-----------------------------------------------------------------------
--  wiki -- Ada Wiki Engine
--  Copyright (C) 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 Wiki.Attributes;
with Wiki.Strings;
with Ada.Finalization;
with Util.Refs;
package Wiki.Nodes is

   pragma Preelaborate;

   subtype WString is Wide_Wide_String;

   type Node_Kind is (N_LINE_BREAK,
                      N_HORIZONTAL_RULE,
                      N_PARAGRAPH,
                      N_HEADER,
                      N_BLOCKQUOTE,
                      N_QUOTE,
                      N_TAG_START,
                      N_PREFORMAT,
                      N_LIST,
                      N_NUM_LIST,
                      N_INDENT,
                      N_TEXT,
                      N_LINK,
                      N_IMAGE);

   --  Node kinds which are simple markers in the document.
   subtype Simple_Node_Kind is Node_Kind range N_LINE_BREAK .. N_PARAGRAPH;

     --  The possible HTML tags as described in HTML5 specification.
   type Html_Tag_Type is
     (
      --  Section 4.1 The root element
      HTML_TAG,

      --  Section 4.2 Document metadata
      HEAD_TAG, TITLE_TAG, BASE_TAG, LINK_TAG, META_TAG, STYLE_TAG,

      --  Section 4.3 Sections
      BODY_TAG, ARTICLE_TAG, SECTION_TAG, NAV_TAG, ASIDE_TAG,
      H1_TAG, H2_TAG, H3_TAG, H4_TAG, H5_TAG, H6_TAG,
      HEADER_TAG, FOOTER_TAG,
      ADDRESS_TAG,

      --  Section 4.4 Grouping content
      P_TAG, HR_TAG, PRE_TAG, BLOCKQUOTE_TAG,
      OL_TAG, UL_TAG, LI_TAG,
      DL_TAG, DT_TAG, DD_TAG,
      FIGURE_TAG, FIGCAPTION_TAG,
      DIV_TAG, MAIN_TAG,

      --  Section 4.5 Text-level semantics
      A_TAG, EM_TAG, STRONG_TAG, SMALL_TAG,
      S_TAG, CITE_TAG, Q_TAG, DFN_TAG, ABBR_TAG,
      DATA_TAG, TIME_TAG, CODE_TAG, VAR_TAG, SAMP_TAG,
      KBD_TAG, SUB_TAG, SUP_TAG,
      I_TAG, B_TAG, U_TAG,
      MARK_TAG, RUBY_TAG, RB_TAG, RT_TAG, RTC_TAG,
      RP_TAG, BDI_TAG, BDO_TAG, SPAN_TAG,
      BR_TAG, WBR_TAG,

      --  Section 4.6 Edits
      INS_TAG, DEL_TAG,

      --  Section 4.7 Embedded content
      IMG_TAG,
      IFRAME_TAG,
      EMBED_TAG,
      OBJECT_TAG,
      PARAM_TAG,
      VIDEO_TAG,
      AUDIO_TAG,
      SOURCE_TAG,
      TRACK_TAG,
      MAP_TAG,
      AREA_TAG,

      --  Section 4.9 Tabular data
      TABLE_TAG, CAPTION_TAG, COLGROUP_TAG, COL_TAG,
      TBODY_TAG, THEAD_TAG, TFOOT_TAG,
      TR_TAG, TD_TAG, TH_TAG,

      --  Section 4.10 Forms
      FORM_TAG, LABEL_TAG, INPUT_TAG,
      BUTTON_TAG, SELECT_TAG, DATALIST_TAG, OPTGROUP_TAG,
      OPTION_TAG, TEXTAREA_TAG, KEYGEN_TAG, OUTPUT_TAG,
      PROGRESS_TAG, METER_TAG, FIELDSET_TAG, LEGEND_TAG,

      --  Section 4.11 Scripting
      SCRIPT_TAG, NOSCRIPT_TAG,
      TEMPLATE_TAG, CANVAS_TAG,

      --  Unknown tags
      UNKNOWN_TAG
     );

   --  Find the tag from the tag name.
   function Find_Tag (Name : in Wide_Wide_String) return Html_Tag_Type;

   type String_Access is access constant String;

   --  Get the HTML tag name.
   function Get_Tag_Name (Tag : in Html_Tag_Type) return String_Access;

   type Node_List is limited private;
   type Node_List_Access is access all Node_List;

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Node_Kind; Len : Natural) is limited record
      case Kind is
         when N_HEADER | N_BLOCKQUOTE | N_INDENT | N_LIST | N_NUM_LIST =>
            Level  : Natural := 0;
            Header : WString (1 .. Len);

         when N_TEXT =>
            Format : Format_Map;
            Text   : WString (1 .. Len);

         when N_LINK | N_IMAGE | N_QUOTE =>
            Link_Attr  : Wiki.Attributes.Attribute_List_Type;
            Title      : WString (1 .. Len);

         when N_TAG_START =>
            Tag_Start  : Html_Tag_Type;
            Attributes : Wiki.Attributes.Attribute_List_Type;
            Children   : Node_List_Access;
            Parent     : Node_Type_Access;

         when N_PREFORMAT =>
            Preformatted : WString (1 .. Len);

         when others =>
            null;

      end case;
   end record;

   type Document is tagged private;

   --  Append a node to the document.
   procedure Append (Into : in out Document;
                     Node : in Node_Type_Access);

   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind);

   --  Append a HTML tag start node to the document.
   procedure Push_Node (Document   : in out Wiki.Nodes.Document;
                        Tag        : in Html_Tag_Type;
                        Attributes : in Wiki.Attributes.Attribute_List_Type);

   --  Pop the HTML tag.
   procedure Pop_Node (Document : in out Wiki.Nodes.Document;
                       Tag      : in Html_Tag_Type);

   --  Append the text with the given format at end of the document.
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map);

   --  Append a section header at end of the document.
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive);

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

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

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

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

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

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

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (List    : in Node_List_Access;
                      Process : not null access procedure (Node : in Node_Type));

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type));

private

   NODE_LIST_BLOCK_SIZE : constant Positive := 20;

   type Node_Array is array (Positive range <>) of Node_Type_Access;

   type Node_List_Block;
   type Node_List_Block_Access is access all Node_List_Block;

   type Node_List_Block (Max : Positive) is limited record
      Next  : Node_List_Block_Access;
      Last  : Natural := 0;
      List  : Node_Array (1 .. Max);
   end record;

   type Node_List is limited new Util.Refs.Ref_Entity with record
      Current : Node_List_Block_Access;
      Length  : Natural := 0;
      First   : aliased Node_List_Block (NODE_LIST_BLOCK_SIZE);
   end record;

   --  Append a node to the node list.
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access);

   package Node_List_Refs is new Util.Refs.References (Node_List, Node_List_Access);

   subtype Node_List_Ref is  Node_List_Refs.Ref;

   type Document is new Ada.Finalization.Controlled with record
      Nodes   : Node_List_Ref;
      Current : Node_Type_Access;
   end record;

   overriding
   procedure Initialize (Doc : in out Document);

end Wiki.Nodes;

Add N_LIST and N_NUM_LIST types

Add N_LIST and N_NUM_LIST types