-----------------------------------------------------------------------
--  components-widgets-panels -- Collapsible panels
--  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 Util.Beans.Objects;
with ASF.Components.Base;
package body ASF.Components.Widgets.Panels is

   procedure Render_Action_Icon (Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                                 Name    : in String) is
   begin
      Writer.Start_Element ("a");
      Writer.Write_Attribute ("href", "#");
      Writer.Write_Attribute ("class", "ui-panel-icon ui-corner-all ui-state-default");
      Writer.Start_Element ("span");
      Writer.Write_Attribute ("class", Name);
      Writer.End_Element ("span");
      Writer.End_Element ("a");
   end Render_Action_Icon;

   --  ------------------------------
   --  Render the panel header.
   --  ------------------------------
   procedure Render_Header (UI      : in UIPanel;
                            Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                            Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Components.Base.UIComponent_Access;

      Header       : Util.Beans.Objects.Object;
      Header_Facet : ASF.Components.Base.UIComponent_Access;
      Closable     : constant Boolean := UI.Get_Attribute (CLOSABLE_ATTR_NAME, Context);
      Toggleable   : constant Boolean := UI.Get_Attribute (TOGGLEABLE_ATTR_NAME, Context);
   begin
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "ui-panel-header ui-widget-header");
      Header := UI.Get_Attribute (Name => HEADER_ATTR_NAME, Context => Context);
      if not Util.Beans.Objects.Is_Empty (Header) then
         Writer.Start_Element ("span");
         Writer.Write_Text (Header);
         Writer.End_Element ("span");
      end if;

      --  If there is a header facet, render it now.
      Header_Facet := UI.Get_Facet (HEADER_FACET_NAME);
      if Header_Facet /= null then
         Header_Facet.Encode_All (Context);
      end if;

      if Closable then
         Render_Action_Icon (Writer, "ui-icon ui-icon-closethick");
      end if;

      if Toggleable then
         Render_Action_Icon (Writer, "ui-icon ui-icon-minusthick");
      end if;
      Writer.End_Element ("div");

      --  Write the javascript to support the close and toggle actions.
      if Closable or Toggleable then
         Writer.Queue_Script ("$(""#");
         Writer.Queue_Script (UI.Get_Client_Id);
         Writer.Queue_Script (""").panel();");
      end if;
   end Render_Header;

   --  ------------------------------
   --  Render the panel footer.
   --  ------------------------------
   procedure Render_Footer (UI      : in UIPanel;
                            Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                            Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Components.Base.UIComponent_Access;

      Footer       : Util.Beans.Objects.Object;
      Footer_Facet : ASF.Components.Base.UIComponent_Access;
      Has_Footer   : Boolean;
   begin
      Footer_Facet := UI.Get_Facet (FOOTER_FACET_NAME);
      Footer := UI.Get_Attribute (Name => FOOTER_ATTR_NAME, Context => Context);

      Has_Footer := Footer_Facet /= null or else not Util.Beans.Objects.Is_Empty (Footer);
      if Has_Footer then
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("class", "ui-panel-footer ui-widget-footer");
      end if;
      if not Util.Beans.Objects.Is_Empty (Footer) then
         Writer.Write_Text (Footer);
      end if;

      --  If there is a footer facet, render it now.
      if Footer_Facet /= null then
         Footer_Facet.Encode_All (Context);
      end if;
      if Has_Footer then
         Writer.End_Element ("div");
      end if;
   end Render_Footer;

   --  ------------------------------
   --  Render the panel header and prepare for the panel content.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIPanel;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("id", UI.Get_Client_Id);
         declare
            use Util.Beans.Objects;

            Style   : constant Object := UI.Get_Attribute (Context, "style");
            Class   : constant Object := UI.Get_Attribute (Context, "styleClass");
         begin
            if not Util.Beans.Objects.Is_Null (Class) then
               Writer.Write_Attribute ("class", To_String (Class)
                                       & " ui-panel ui-widget ui-corner-all");
            else
               Writer.Write_Attribute ("class", "ui-panel ui-widget ui-corner-all");
            end if;
            if not Is_Null (Style) then
               Writer.Write_Attribute ("style", Style);
            end if;
         end;
         UIPanel'Class (UI).Render_Header (Writer.all, Context);
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("class", "ui-panel-content ui-widget-content");
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Render the panel footer.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIPanel;
                         Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.End_Element ("div");
         UIPanel'Class (UI).Render_Footer (Writer.all, Context);
         Writer.End_Element ("div");
      end if;
   end Encode_End;

end ASF.Components.Widgets.Panels;

-----------------------------------------------------------------------
--  components-widgets-panels -- Collapsible panels
--  Copyright (C) 2013, 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.Beans.Objects;
with ASF.Components.Base;
package body ASF.Components.Widgets.Panels is

   procedure Render_Action_Icon (Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                                 Name    : in String);

   procedure Render_Action_Icon (Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                                 Name    : in String) is
   begin
      Writer.Start_Element ("a");
      Writer.Write_Attribute ("href", "#");
      Writer.Write_Attribute ("class", "ui-panel-icon ui-corner-all ui-state-default");
      Writer.Start_Element ("span");
      Writer.Write_Attribute ("class", Name);
      Writer.End_Element ("span");
      Writer.End_Element ("a");
   end Render_Action_Icon;

   --  ------------------------------
   --  Render the panel header.
   --  ------------------------------
   procedure Render_Header (UI      : in UIPanel;
                            Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                            Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Components.Base.UIComponent_Access;

      Header       : Util.Beans.Objects.Object;
      Header_Facet : ASF.Components.Base.UIComponent_Access;
      Closable     : constant Boolean := UI.Get_Attribute (CLOSABLE_ATTR_NAME, Context);
      Toggleable   : constant Boolean := UI.Get_Attribute (TOGGLEABLE_ATTR_NAME, Context);
   begin
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "ui-panel-header ui-widget-header");
      Header := UI.Get_Attribute (Name => HEADER_ATTR_NAME, Context => Context);
      if not Util.Beans.Objects.Is_Empty (Header) then
         Writer.Start_Element ("span");
         Writer.Write_Text (Header);
         Writer.End_Element ("span");
      end if;

      --  If there is a header facet, render it now.
      Header_Facet := UI.Get_Facet (HEADER_FACET_NAME);
      if Header_Facet /= null then
         Header_Facet.Encode_All (Context);
      end if;

      if Closable then
         Render_Action_Icon (Writer, "ui-icon ui-icon-closethick");
      end if;

      if Toggleable then
         Render_Action_Icon (Writer, "ui-icon ui-icon-minusthick");
      end if;
      Writer.End_Element ("div");

      --  Write the javascript to support the close and toggle actions.
      if Closable or Toggleable then
         Writer.Queue_Script ("$(""#");
         Writer.Queue_Script (UI.Get_Client_Id);
         Writer.Queue_Script (""").panel();");
      end if;
   end Render_Header;

   --  ------------------------------
   --  Render the panel footer.
   --  ------------------------------
   procedure Render_Footer (UI      : in UIPanel;
                            Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                            Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Components.Base.UIComponent_Access;

      Footer       : Util.Beans.Objects.Object;
      Footer_Facet : ASF.Components.Base.UIComponent_Access;
      Has_Footer   : Boolean;
   begin
      Footer_Facet := UI.Get_Facet (FOOTER_FACET_NAME);
      Footer := UI.Get_Attribute (Name => FOOTER_ATTR_NAME, Context => Context);

      Has_Footer := Footer_Facet /= null or else not Util.Beans.Objects.Is_Empty (Footer);
      if Has_Footer then
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("class", "ui-panel-footer ui-widget-footer");
      end if;
      if not Util.Beans.Objects.Is_Empty (Footer) then
         Writer.Write_Text (Footer);
      end if;

      --  If there is a footer facet, render it now.
      if Footer_Facet /= null then
         Footer_Facet.Encode_All (Context);
      end if;
      if Has_Footer then
         Writer.End_Element ("div");
      end if;
   end Render_Footer;

   --  ------------------------------
   --  Render the panel header and prepare for the panel content.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIPanel;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("id", UI.Get_Client_Id);
         declare
            use Util.Beans.Objects;

            Style   : constant Object := UI.Get_Attribute (Context, "style");
            Class   : constant Object := UI.Get_Attribute (Context, "styleClass");
         begin
            if not Util.Beans.Objects.Is_Null (Class) then
               Writer.Write_Attribute ("class", To_String (Class)
                                       & " ui-panel ui-widget ui-corner-all");
            else
               Writer.Write_Attribute ("class", "ui-panel ui-widget ui-corner-all");
            end if;
            if not Is_Null (Style) then
               Writer.Write_Attribute ("style", Style);
            end if;
         end;
         UIPanel'Class (UI).Render_Header (Writer.all, Context);
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("class", "ui-panel-content ui-widget-content");
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Render the panel footer.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIPanel;
                         Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.End_Element ("div");
         UIPanel'Class (UI).Render_Footer (Writer.all, Context);
         Writer.End_Element ("div");
      end if;
   end Encode_End;

end ASF.Components.Widgets.Panels;

Declare the Render_Action_Icon procedure


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

package body MAT.Consoles is

   --  ------------------------------
   --  Print the title for the given field and setup the associated field size.
   --  ------------------------------
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String;
                          Length  : in Positive) is
   begin
      Console.Sizes (Field) := Length;
      if Console.Field_Count >= 1 then
         Console.Cols (Field) := Console.Cols (Console.Fields (Console.Field_Count))
           + Console.Sizes (Console.Fields (Console.Field_Count));
      else
         Console.Cols (Field) := 1;
      end if;
      Console.Field_Count := Console.Field_Count + 1;
      Console.Fields (Console.Field_Count) := Field;
      Console_Type'Class (Console).Print_Title (Field, Title);
   end Print_Title;

   --  ------------------------------
   --  Format the address and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr) is
      Value : constant String := MAT.Types.Hex_Image (Addr);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Field;

   --  ------------------------------
   --  Format the size and print it for the given field.
   --  ------------------------------
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size) is
      Value : constant String := MAT.Types.Target_Size'Image (Size);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Size;

   --  ------------------------------
   --  Format the integer and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Integer) is
      Val : constant String := Integer'Image (Value);
   begin
      Console_Type'Class (Console).Print_Field (Field, Val);
   end Print_Field;

end MAT.Consoles;

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

package body MAT.Consoles is

   --  ------------------------------
   --  Print the title for the given field and setup the associated field size.
   --  ------------------------------
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String;
                          Length  : in Positive) is
   begin
      Console.Sizes (Field) := Length;
      if Console.Field_Count >= 1 then
         Console.Cols (Field) := Console.Cols (Console.Fields (Console.Field_Count))
           + Console.Sizes (Console.Fields (Console.Field_Count));
      else
         Console.Cols (Field) := 1;
      end if;
      Console.Field_Count := Console.Field_Count + 1;
      Console.Fields (Console.Field_Count) := Field;
      Console_Type'Class (Console).Print_Title (Field, Title);
   end Print_Title;

   --  ------------------------------
   --  Format the address and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr) is
      Value : constant String := MAT.Types.Hex_Image (Addr);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Field;

   --  ------------------------------
   --  Format the size and print it for the given field.
   --  ------------------------------
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size) is
      Value : constant String := MAT.Types.Target_Size'Image (Size);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Size;

   --  ------------------------------
   --  Format the integer and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Integer) is
      Val : constant String := Integer'Image (Value);
   begin
      Console_Type'Class (Console).Print_Field (Field, Val);
   end Print_Field;

   --  ------------------------------
   --  Format the integer and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Console_Type'Class (Console).Print_Field (Field, Ada.Strings.Unbounded.To_String (Value));
   end Print_Field;

end MAT.Consoles;

Implement the Print_Field operation for an Unbounded_String


-----------------------------------------------------------------------
--  Clients - Abstract representation of client information
--  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.Command_Line;

with GNAT.Command_Line;

with Readline;

with Util.Strings;
with Util.Log.Loggers;

with MAT.Commands;
with MAT.Targets.Probes;
package body MAT.Targets is

   --  ------------------------------
   --  Get the console instance.
   --  ------------------------------
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access is
   begin
      return Target.Console;
   end Console;

   --  ------------------------------
   --  Set the console instance.
   --  ------------------------------
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access) is
   begin
      Target.Console := Console;
   end Console;

   --  ------------------------------
   --  Get the current process instance.
   --  ------------------------------
   function Process (Target : in Target_Type) return Target_Process_Type_Access is
   begin
      return Target.Current;
   end Process;

   --  ------------------------------
   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class) is
   begin
      MAT.Targets.Probes.Initialize (Target  => Target,
                                     Manager => Reader);
   end Initialize;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access) is
      Path_String : constant String := Ada.Strings.Unbounded.To_String (Path);
   begin
      Process := Target.Find_Process (Pid);
      if Process = null then
         Process := new Target_Process_Type;
         Process.Pid := Pid;
         Process.Path := Path;
         Process.Symbols := MAT.Symbols.Targets.Target_Symbols_Refs.Create;
         Process.Symbols.Value.Console := Target.Console;
         Target.Processes.Insert (Pid, Process);
         Target.Console.Notice (MAT.Consoles.N_PID_INFO,
                                "Process" & MAT.Types.Target_Process_Ref'Image (Pid) & " created");
         Target.Console.Notice (MAT.Consoles.N_PATH_INFO,
                                "Path " & Path_String);
      end if;
      if Target.Current = null then
         Target.Current := Process;
      end if;
      if Target.Options.Load_Symbols then
         MAT.Commands.Symbol_Command (Target, Path_String);
      end if;
   end Create_Process;

   --  ------------------------------
   --  Find the process instance from the process ID.
   --  ------------------------------
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access is
      Pos : constant Process_Cursor := Target.Processes.Find (Pid);
   begin
      if Process_Maps.Has_Element (Pos) then
         return Process_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Process;

   --  ------------------------------
   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class)) is
      Iter : Process_Cursor := Target.Processes.First;
   begin
      while Process_Maps.Has_Element (Iter) loop
         Process (Process_Maps.Element (Iter).all);
         Process_Maps.Next (Iter);
      end loop;
   end Iterator;

   --  ------------------------------
   --  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 is
      Pos    : constant Natural := Util.Strings.Index (Param, ':');
      Result : GNAT.Sockets.Sock_Addr_Type;
   begin
      if Pos > 0 then
         Result.Port := GNAT.Sockets.Port_Type'Value (Param (Pos + 1 .. Param'Last));
         Result.Addr := GNAT.Sockets.Inet_Addr (Param (Param'First .. Pos - 1));
      else
         Result.Port := GNAT.Sockets.Port_Type'Value (Param);
         Result.Addr := GNAT.Sockets.Any_Inet_Addr;
      end if;
      return Result;
   end To_Sock_Addr_Type;

   --  ------------------------------
   --  Print the application usage.
   --  ------------------------------
   procedure Usage is
      use Ada.Text_IO;
   begin
      Put_Line ("Usage: mat [-i] [-e] [-nw] [-ns] [-b [ip:]port] [file.mat]");
      Put_Line ("-i            Enable the interactive mode");
      Put_Line ("-e            Print the probe events as they are received");
      Put_Line ("-nw           Disable the graphical mode");
      Put_Line ("-b [ip:]port  Define the port and local address to bind");
      Put_Line ("-ns           Disable the automatic symbols loading");
      Ada.Command_Line.Set_Exit_Status (2);
      raise Usage_Error;
   end Usage;

   --  ------------------------------
   --  Parse the command line arguments and configure the target instance.
   --  ------------------------------
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type) is
   begin
      Util.Log.Loggers.Initialize ("matp.properties");
      GNAT.Command_Line.Initialize_Option_Scan (Stop_At_First_Non_Switch => True,
                                                Section_Delimiters       => "targs");
      loop
         case GNAT.Command_Line.Getopt ("i e nw ns b:") is
            when ASCII.NUL =>
               exit;

            when 'i' =>
               Target.Options.Interactive := True;

            when 'e' =>
               Target.Options.Print_Events := True;

            when 'b' =>
               Target.Options.Address := To_Sock_Addr_Type (GNAT.Command_Line.Parameter);

            when 'n' =>
               if GNAT.Command_Line.Full_Switch = "nw" then
                  Target.Options.Graphical := False;
               else
                  Target.Options.Load_Symbols := False;
               end if;

            when '*' =>
               exit;

            when others =>
               Usage;

         end case;
      end loop;

   exception
      when Usage_Error =>
         raise;

      when others =>
         Usage;

   end Initialize_Options;

   --  ------------------------------
   --  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) is
   begin
      loop
         declare
            Line : constant String := Readline.Get_Line ("matp>");
         begin
            MAT.Commands.Execute (Target, Line);

         exception
            when MAT.Commands.Stop_Interp =>
               exit;
         end;
      end loop;
   end Interactive;

   --  ------------------------------
   --  Start the server to listen to MAT event socket streams.
   --  ------------------------------
   procedure Start (Target : in out Target_Type) is
   begin
      Target.Server.Start (Target'Unchecked_Access, Target.Options.Address);
   end Start;

   --  ------------------------------
   --  Stop the server thread.
   --  ------------------------------
   procedure Stop (Target : in out Target_Type) is
   begin
      Target.Server.Stop;
   end Stop;

end MAT.Targets;

-----------------------------------------------------------------------
--  Clients - Abstract representation of client information
--  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.Command_Line;
with Ada.Unchecked_Deallocation;

with GNAT.Command_Line;

with Readline;

with Util.Strings;
with Util.Log.Loggers;

with MAT.Commands;
with MAT.Targets.Probes;
package body MAT.Targets is

   procedure Free is
     new Ada.Unchecked_Deallocation (MAT.Events.Targets.Target_Events'Class,
                                     MAT.Events.Targets.Target_Events_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (Target_Process_Type'Class,
                                     Target_Process_Type_Access);

   --  ------------------------------
   --  Release the target process instance.
   --  ------------------------------
   overriding
   procedure Finalize (Target : in out Target_Process_Type) is
   begin
      Free (Target.Events);
   end Finalize;

   --  ------------------------------
   --  Get the console instance.
   --  ------------------------------
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access is
   begin
      return Target.Console;
   end Console;

   --  ------------------------------
   --  Set the console instance.
   --  ------------------------------
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access) is
   begin
      Target.Console := Console;
   end Console;

   --  ------------------------------
   --  Get the current process instance.
   --  ------------------------------
   function Process (Target : in Target_Type) return Target_Process_Type_Access is
   begin
      return Target.Current;
   end Process;

   --  ------------------------------
   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class) is
   begin
      MAT.Targets.Probes.Initialize (Target  => Target,
                                     Manager => Reader);
   end Initialize;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access) is
      Path_String : constant String := Ada.Strings.Unbounded.To_String (Path);
   begin
      Process := Target.Find_Process (Pid);
      if Process = null then
         Process := new Target_Process_Type;
         Process.Pid := Pid;
         Process.Path := Path;
         Process.Symbols := MAT.Symbols.Targets.Target_Symbols_Refs.Create;
         Process.Symbols.Value.Console := Target.Console;
         Target.Processes.Insert (Pid, Process);
         Target.Console.Notice (MAT.Consoles.N_PID_INFO,
                                "Process" & MAT.Types.Target_Process_Ref'Image (Pid) & " created");
         Target.Console.Notice (MAT.Consoles.N_PATH_INFO,
                                "Path " & Path_String);
      end if;
      if Target.Current = null then
         Target.Current := Process;
      end if;
      if Target.Options.Load_Symbols then
         MAT.Commands.Symbol_Command (Target, Path_String);
      end if;
   end Create_Process;

   --  ------------------------------
   --  Find the process instance from the process ID.
   --  ------------------------------
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access is
      Pos : constant Process_Cursor := Target.Processes.Find (Pid);
   begin
      if Process_Maps.Has_Element (Pos) then
         return Process_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Process;

   --  ------------------------------
   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class)) is
      Iter : Process_Cursor := Target.Processes.First;
   begin
      while Process_Maps.Has_Element (Iter) loop
         Process (Process_Maps.Element (Iter).all);
         Process_Maps.Next (Iter);
      end loop;
   end Iterator;

   --  ------------------------------
   --  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 is
      Pos    : constant Natural := Util.Strings.Index (Param, ':');
      Result : GNAT.Sockets.Sock_Addr_Type;
   begin
      if Pos > 0 then
         Result.Port := GNAT.Sockets.Port_Type'Value (Param (Pos + 1 .. Param'Last));
         Result.Addr := GNAT.Sockets.Inet_Addr (Param (Param'First .. Pos - 1));
      else
         Result.Port := GNAT.Sockets.Port_Type'Value (Param);
         Result.Addr := GNAT.Sockets.Any_Inet_Addr;
      end if;
      return Result;
   end To_Sock_Addr_Type;

   --  ------------------------------
   --  Print the application usage.
   --  ------------------------------
   procedure Usage is
      use Ada.Text_IO;
   begin
      Put_Line ("Usage: mat [-i] [-e] [-nw] [-ns] [-b [ip:]port] [file.mat]");
      Put_Line ("-i            Enable the interactive mode");
      Put_Line ("-e            Print the probe events as they are received");
      Put_Line ("-nw           Disable the graphical mode");
      Put_Line ("-b [ip:]port  Define the port and local address to bind");
      Put_Line ("-ns           Disable the automatic symbols loading");
      Ada.Command_Line.Set_Exit_Status (2);
      raise Usage_Error;
   end Usage;

   --  ------------------------------
   --  Parse the command line arguments and configure the target instance.
   --  ------------------------------
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type) is
   begin
      Util.Log.Loggers.Initialize ("matp.properties");
      GNAT.Command_Line.Initialize_Option_Scan (Stop_At_First_Non_Switch => True,
                                                Section_Delimiters       => "targs");
      loop
         case GNAT.Command_Line.Getopt ("i e nw ns b:") is
            when ASCII.NUL =>
               exit;

            when 'i' =>
               Target.Options.Interactive := True;

            when 'e' =>
               Target.Options.Print_Events := True;

            when 'b' =>
               Target.Options.Address := To_Sock_Addr_Type (GNAT.Command_Line.Parameter);

            when 'n' =>
               if GNAT.Command_Line.Full_Switch = "nw" then
                  Target.Options.Graphical := False;
               else
                  Target.Options.Load_Symbols := False;
               end if;

            when '*' =>
               exit;

            when others =>
               Usage;

         end case;
      end loop;

   exception
      when Usage_Error =>
         raise;

      when others =>
         Usage;

   end Initialize_Options;

   --  ------------------------------
   --  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) is
   begin
      loop
         declare
            Line : constant String := Readline.Get_Line ("matp>");
         begin
            MAT.Commands.Execute (Target, Line);

         exception
            when MAT.Commands.Stop_Interp =>
               exit;
         end;
      end loop;
   end Interactive;

   --  ------------------------------
   --  Start the server to listen to MAT event socket streams.
   --  ------------------------------
   procedure Start (Target : in out Target_Type) is
   begin
      Target.Server.Start (Target'Unchecked_Access, Target.Options.Address);
   end Start;

   --  ------------------------------
   --  Stop the server thread.
   --  ------------------------------
   procedure Stop (Target : in out Target_Type) is
   begin
      Target.Server.Stop;
   end Stop;

   --  ------------------------------
   --  Release the storage used by the target object.
   --  ------------------------------
   overriding
   procedure Finalize (Target : in out Target_Type) is
   begin
      while not Target.Processes.Is_Empty loop
         declare
            Process : Target_Process_Type_Access := Target.Processes.First_Element;
         begin
            Free (Process);
            Target.Processes.Delete_First;
         end;
      end loop;
   end Finalize;

end MAT.Targets;

Implement the Finalize for Target_Process_Type and Target_Type objects


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

with ASF.Components.Base;
with ASF.Components.Html.Text;
with ASF.Components.Html.Lists;
with ASF.Components.Html.Links;
with ASF.Components.Html.Panels;
with ASF.Components.Html.Forms;
with ASF.Views.Nodes;
package body ASF.Components.Html.Factory is

   use ASF.Components.Base;

   function Create_Output return UIComponent_Access;
   function Create_Output_Link return UIComponent_Access;
   function Create_Output_Format return UIComponent_Access;
   function Create_Label return UIComponent_Access;
   function Create_List return UIComponent_Access;
   function Create_PanelGroup return UIComponent_Access;
   function Create_Form return UIComponent_Access;
   function Create_Input return UIComponent_Access;
   function Create_Command return UIComponent_Access;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutput;
   end Create_Output;

   --  ------------------------------
   --  Create an UIOutputLink component
   --  ------------------------------
   function Create_Output_Link return UIComponent_Access is
   begin
      return new ASF.Components.Html.Links.UIOutputLink;
   end Create_Output_Link;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output_Format return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutputFormat;
   end Create_Output_Format;

   --  ------------------------------
   --  Create a label component
   --  ------------------------------
   function Create_Label return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UILabel;
   end Create_Label;

   --  ------------------------------
   --  Create an UIList component
   --  ------------------------------
   function Create_List return UIComponent_Access is
   begin
      return new ASF.Components.Html.Lists.UIList;
   end Create_List;

   --  ------------------------------
   --  Create an UIPanelGroup component
   --  ------------------------------
   function Create_PanelGroup return UIComponent_Access is
   begin
      return new ASF.Components.Html.Panels.UIPanelGroup;
   end Create_PanelGroup;

   --  ------------------------------
   --  Create an UIForm component
   --  ------------------------------
   function Create_Form return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIForm;
   end Create_Form;

   --  ------------------------------
   --  Create an UIInput component
   --  ------------------------------
   function Create_Input return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInput;
   end Create_Input;

   --  ------------------------------
   --  Create an UICommand component
   --  ------------------------------
   function Create_Command return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UICommand;
   end Create_Command;

   use ASF.Views.Nodes;

   URI                : aliased constant String := "http://java.sun.com/jsf/html";
   COMMAND_BUTTON_TAG : aliased constant String := "commandButton";
   FORM_TAG           : aliased constant String := "form";
   INPUT_TAG          : aliased constant String := "input";
   LABEL_TAG          : aliased constant String := "label";
   LIST_TAG           : aliased constant String := "list";
   OUTPUT_FORMAT_TAG  : aliased constant String := "outputFormat";
   OUTPUT_LINK_TAG    : aliased constant String := "outputLink";
   OUTPUT_TEXT_TAG    : aliased constant String := "outputText";
   PANEL_GROUP_TAG    : aliased constant String := "panelGroup";

   Html_Bindings : aliased constant ASF.Factory.Binding_Array
     := (1 => (Name      => COMMAND_BUTTON_TAG'Access,
               Component => Create_Command'Access,
               Tag       => Create_Component_Node'Access),
         2 => (Name      => FORM_TAG'Access,
               Component => Create_Form'Access,
               Tag       => Create_Component_Node'Access),
         3 => (Name      => INPUT_TAG'Access,
               Component => Create_Input'Access,
               Tag       => Create_Component_Node'Access),
         4 => (Name      => LABEL_TAG'Access,
               Component => Create_Label'Access,
               Tag       => Create_Component_Node'Access),
         5 => (Name      => LIST_TAG'Access,
               Component => Create_List'Access,
               Tag       => Create_Component_Node'Access),
         6 => (Name      => OUTPUT_FORMAT_TAG'Access,
               Component => Create_Output_Format'Access,
               Tag       => Create_Component_Node'Access),
         7 => (Name      => OUTPUT_LINK_TAG'Access,
               Component => Create_Output_Link'Access,
               Tag       => Create_Component_Node'Access),
         8 => (Name      => OUTPUT_TEXT_TAG'Access,
               Component => Create_Output'Access,
               Tag       => Create_Component_Node'Access),
         9 => (Name      => PANEL_GROUP_TAG'Access,
               Component => Create_PanelGroup'Access,
               Tag       => Create_Component_Node'Access)
        );

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

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

end ASF.Components.Html.Factory;

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

with ASF.Components.Base;
with ASF.Components.Html.Text;
with ASF.Components.Html.Lists;
with ASF.Components.Html.Links;
with ASF.Components.Html.Panels;
with ASF.Components.Html.Forms;
with ASF.Views.Nodes;
package body ASF.Components.Html.Factory is

   use ASF.Components.Base;

   function Create_Output return UIComponent_Access;
   function Create_Output_Link return UIComponent_Access;
   function Create_Output_Format return UIComponent_Access;
   function Create_Label return UIComponent_Access;
   function Create_List return UIComponent_Access;
   function Create_PanelGroup return UIComponent_Access;
   function Create_Form return UIComponent_Access;
   function Create_Input return UIComponent_Access;
   function Create_Command return UIComponent_Access;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutput;
   end Create_Output;

   --  ------------------------------
   --  Create an UIOutputLink component
   --  ------------------------------
   function Create_Output_Link return UIComponent_Access is
   begin
      return new ASF.Components.Html.Links.UIOutputLink;
   end Create_Output_Link;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output_Format return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutputFormat;
   end Create_Output_Format;

   --  ------------------------------
   --  Create a label component
   --  ------------------------------
   function Create_Label return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UILabel;
   end Create_Label;

   --  ------------------------------
   --  Create an UIList component
   --  ------------------------------
   function Create_List return UIComponent_Access is
   begin
      return new ASF.Components.Html.Lists.UIList;
   end Create_List;

   --  ------------------------------
   --  Create an UIPanelGroup component
   --  ------------------------------
   function Create_PanelGroup return UIComponent_Access is
   begin
      return new ASF.Components.Html.Panels.UIPanelGroup;
   end Create_PanelGroup;

   --  ------------------------------
   --  Create an UIForm component
   --  ------------------------------
   function Create_Form return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIForm;
   end Create_Form;

   --  ------------------------------
   --  Create an UIInput component
   --  ------------------------------
   function Create_Input return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInput;
   end Create_Input;

   --  ------------------------------
   --  Create an UICommand component
   --  ------------------------------
   function Create_Command return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UICommand;
   end Create_Command;

   use ASF.Views.Nodes;

   URI                : aliased constant String := "http://java.sun.com/jsf/html";
   COMMAND_BUTTON_TAG : aliased constant String := "commandButton";
   FORM_TAG           : aliased constant String := "form";
   INPUT_SECRET_TAG   : aliased constant String := "inputSecret";
   INPUT_TEXT_TAG     : aliased constant String := "inputText";
   LABEL_TAG          : aliased constant String := "label";
   LIST_TAG           : aliased constant String := "list";
   OUTPUT_FORMAT_TAG  : aliased constant String := "outputFormat";
   OUTPUT_LINK_TAG    : aliased constant String := "outputLink";
   OUTPUT_TEXT_TAG    : aliased constant String := "outputText";
   PANEL_GROUP_TAG    : aliased constant String := "panelGroup";

   Html_Bindings : aliased constant ASF.Factory.Binding_Array
     := (1 => (Name      => COMMAND_BUTTON_TAG'Access,
               Component => Create_Command'Access,
               Tag       => Create_Component_Node'Access),
         2 => (Name      => FORM_TAG'Access,
               Component => Create_Form'Access,
               Tag       => Create_Component_Node'Access),
         3 => (Name      => INPUT_SECRET_TAG'Access,
               Component => Create_Input'Access,
               Tag       => Create_Component_Node'Access),
         4 => (Name      => INPUT_TEXT_TAG'Access,
               Component => Create_Input'Access,
               Tag       => Create_Component_Node'Access),
         5 => (Name      => LABEL_TAG'Access,
               Component => Create_Label'Access,
               Tag       => Create_Component_Node'Access),
         6 => (Name      => LIST_TAG'Access,
               Component => Create_List'Access,
               Tag       => Create_Component_Node'Access),
         7 => (Name      => OUTPUT_FORMAT_TAG'Access,
               Component => Create_Output_Format'Access,
               Tag       => Create_Component_Node'Access),
         8 => (Name      => OUTPUT_LINK_TAG'Access,
               Component => Create_Output_Link'Access,
               Tag       => Create_Component_Node'Access),
         9 => (Name      => OUTPUT_TEXT_TAG'Access,
               Component => Create_Output'Access,
               Tag       => Create_Component_Node'Access),
        10 => (Name      => PANEL_GROUP_TAG'Access,
               Component => Create_PanelGroup'Access,
               Tag       => Create_Component_Node'Access)
        );

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

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

end ASF.Components.Html.Factory;

Rename h:input into h:inputText and add h:inputSecret


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

with Util.Test_Caller;

package body Util.Events.Timers.Tests is

   use Util.Tests;
   use type Ada.Real_Time.Time;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Is_Scheduled",
                       Test_Empty_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Process",
                       Test_Timer_Event'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat",
                       Test_Repeat_Timer'Access);
   end Add_Tests;

   overriding
   procedure Time_Handler (Sub   : in out Test;
                           Event : in out Timer_Ref'Class) is
   begin
      Sub.Count := Sub.Count + 1;
      if Sub.Repeat > 1 then
         Sub.Repeat := Sub.Repeat - 1;
         Event.Repeat (Ada.Real_Time.Milliseconds (1));
      end if;
   end Time_Handler;

   --  -----------------------
   --  Test empty timers.
   --  -----------------------
   procedure Test_Empty_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Deadline : Ada.Real_Time.Time;
   begin
      T.Assert (not R.Is_Scheduled, "Empty timer should not be scheduled");
      T.Assert (R.Time_Of_Event = Ada.Real_Time.Time_Last, "Time_Of_Event returned invalid value");
      R.Cancel;
      M.Process (Deadline);
      T.Assert (Deadline = Ada.Real_Time.Time_Last,
                "The Process operation returned invalid deadline");
   end Test_Empty_Timer;

   procedure Test_Timer_Event (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      delay until Deadline;
      M.Process (Deadline);
      Assert_Equals (T, 1, T.Count, "The timer handler was not called");
   end Test_Timer_Event;

   --  -----------------------
   --  Test repeating timers.
   --  -----------------------
   procedure Test_Repeat_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      T.Count := 0;
      T.Repeat := 5;
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      loop
         delay until Deadline;
         M.Process (Deadline);
         exit when Deadline >= Now + Ada.Real_Time.Seconds (1);
      end loop;
      Assert_Equals (T, 5, T.Count, "The timer handler was not repeated");
   end Test_Repeat_Timer;

end Util.Events.Timers.Tests;

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

with Util.Test_Caller;

package body Util.Events.Timers.Tests is

   use Util.Tests;
   use type Ada.Real_Time.Time;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Is_Scheduled",
                       Test_Empty_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Process",
                       Test_Timer_Event'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat",
                       Test_Repeat_Timer'Access);
      Caller.Add_Test (Suite, "Test Util.Events.Timers.Repeat+Process",
                       Test_Many_Timers'Access);
   end Add_Tests;

   overriding
   procedure Time_Handler (Sub   : in out Test;
                           Event : in out Timer_Ref'Class) is
   begin
      Sub.Count := Sub.Count + 1;
      if Sub.Repeat > 1 then
         Sub.Repeat := Sub.Repeat - 1;
         Event.Repeat (Ada.Real_Time.Milliseconds (1));
      end if;
   end Time_Handler;

   --  -----------------------
   --  Test empty timers.
   --  -----------------------
   procedure Test_Empty_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Deadline : Ada.Real_Time.Time;
   begin
      T.Assert (not R.Is_Scheduled, "Empty timer should not be scheduled");
      T.Assert (R.Time_Of_Event = Ada.Real_Time.Time_Last, "Time_Of_Event returned invalid value");
      R.Cancel;
      M.Process (Deadline);
      T.Assert (Deadline = Ada.Real_Time.Time_Last,
                "The Process operation returned invalid deadline");
   end Test_Empty_Timer;

   procedure Test_Timer_Event (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      delay until Deadline;
      M.Process (Deadline);
      Assert_Equals (T, 1, T.Count, "The timer handler was not called");
   end Test_Timer_Event;

   --  -----------------------
   --  Test repeating timers.
   --  -----------------------
   procedure Test_Repeat_Timer (T : in out Test) is
      M        : Timer_List;
      R        : Timer_Ref;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      Now      : Ada.Real_Time.Time;
   begin
      T.Count := 0;
      T.Repeat := 5;
      for Retry in 1 .. 10 loop
         M.Set_Timer (T'Unchecked_Access, R, Start + Ada.Real_Time.Milliseconds (10));
         M.Process (Deadline);
         Now := Ada.Real_Time.Clock;
         exit when Now < Deadline;
      end loop;
      T.Assert (Now < Deadline, "The timer deadline is not correct");
      loop
         delay until Deadline;
         M.Process (Deadline);
         exit when Deadline >= Now + Ada.Real_Time.Seconds (1);
      end loop;
      Assert_Equals (T, 5, T.Count, "The timer handler was not repeated");
   end Test_Repeat_Timer;

   --  -----------------------
   --  Test executing several timers.
   --  -----------------------
   procedure Test_Many_Timers (T : in out Test) is
      Timer_Count : constant Positive := 30;

      type Timer_Ref_Array is array (1 .. Timer_Count) of Timer_Ref;
      type Test_Ref_Array is array (1 .. Timer_Count) of aliased Test;

      M        : Timer_List;
      Start    : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
      Deadline : Ada.Real_Time.Time;
      R        : Timer_Ref_Array;
      D        : Test_Ref_Array;
      Dt       : Ada.Real_Time.Time_Span;
      Count    : Natural := 0;
   begin
      for I in R'Range loop
         D (I).Count := 0;
         D (I).Repeat := 4;
         if I mod 2 = 0 then
            Dt := Ada.Real_Time.Milliseconds (40);
         else
            Dt := Ada.Real_Time.Milliseconds (20);
         end if;
         M.Set_Timer (D (I)'Unchecked_Access, R (I), Start + Dt);
      end loop;
      loop
         M.Process (Deadline);
         exit when Deadline >= Start + Ada.Real_Time.Seconds (10);
         Count := Count + 1;
         delay until Deadline;
      end loop;
      Util.Tests.Assert_Equals (T, 4, Count, "Count of Process");
      for I in D'Range loop
         Util.Tests.Assert_Equals (T, 4, D (I).Count, "Invalid count for timer at "
                                     & Natural'Image (I) & " " & Natural'Image (Count));
      end loop;
   end Test_Many_Timers;

end Util.Events.Timers.Tests;

Implement the Test_Many_Timers procedure and register it for execution


-----------------------------------------------------------------------
--  util-processes -- Process creation and control
--  Copyright (C) 2011, 2012, 2016, 2018, 2021 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;
with Util.Systems.Types;

with Ada.Finalization;
with Ada.Strings.Unbounded;
package Util.Processes is

   Invalid_State : exception;

   Process_Error : exception;

   --  The optional process pipes:
   --

   --
NONE

   --
the process will inherit the standard input, output and error.

   --
READ

   --
a pipe is created to read the process standard output.

   --
READ_ERROR

   --
a pipe is created to read the process standard error.  The output and input are
   --    inherited.

   --
READ_ALL

   --
similar to READ the same pipe is used for the process standard error.

   --
WRITE

   --
a pipe is created to write on the process standard input.

   --
READ_WRITE

   --
Combines the READ and WRITE modes.

   --
READ_WRITE_ALL

   --
Combines the READ_ALL and WRITE modes.

   --

   type Pipe_Mode is (NONE, READ, READ_ERROR, READ_ALL, WRITE, READ_WRITE, READ_WRITE_ALL);

   subtype String_Access is Ada.Strings.Unbounded.String_Access;

   subtype File_Type is Util.Systems.Types.File_Type;

   type Argument_List is array (Positive range <>) of String_Access;

   type Process_Identifier is new Integer;

   --  ------------------------------
   --  Process
   --  ------------------------------
   type Process is limited private;

   --  Before launching the process, redirect the input stream of the process
   --  to the specified file.
   --  Raises Invalid_State if the process is running.
   procedure Set_Input_Stream (Proc : in out Process;
                               File : in String);

   --  Set the output stream of the process.
   --  Raises Invalid_State if the process is running.
   procedure Set_Output_Stream (Proc   : in out Process;
                                File   : in String;
                                Append : in Boolean := False);

   --  Set the error stream of the process.
   --  Raises Invalid_State if the process is running.
   procedure Set_Error_Stream (Proc   : in out Process;
                               File   : in String;
                               Append : in Boolean := False);

   --  Set the working directory that the process will use once it is created.
   --  The directory must exist or the Invalid_Directory exception will be raised.
   procedure Set_Working_Directory (Proc : in out Process;
                                    Path : in String);

   --  Set the shell executable path to use to launch a command.  The default on Unix is
   --  the /bin/sh command.  Argument splitting is done by the /bin/sh -c command.
   --  When setting an empty shell command, the argument splitting is done by the
   --  <tt>Spawn</tt> procedure.
   procedure Set_Shell (Proc  : in out Process;
                        Shell : in String);

   --  Closes the given file descriptor in the child process before executing the command.
   procedure Add_Close (Proc  : in out Process;
                        Fd    : in File_Type);

   --  Append the argument to the current process argument list.
   --  Raises Invalid_State if the process is running.
   procedure Append_Argument (Proc : in out Process;
                              Arg  : in String);

   --  Set the environment variable to be used by the process before its creation.
   procedure Set_Environment (Proc  : in out Process;
                              Name  : in String;
                              Value : in String);

   procedure Set_Environment (Proc    : in out Process;
                              Iterate : not null access
                                procedure
                                  (Process : not null access procedure
                                     (Name  : in String;
                                      Value : in String)));

   --  Spawn a new process with the given command and its arguments.  The standard input, output
   --  and error streams are either redirected to a file or to a stream object.
   procedure Spawn (Proc      : in out Process;
                    Command   : in String;
                    Arguments : in Argument_List);

   procedure Spawn (Proc      : in out Process;
                    Command   : in String;
                    Mode      : in Pipe_Mode := NONE);

   --  Wait for the process to terminate.
   procedure Wait (Proc : in out Process);

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   procedure Stop (Proc   : in out Process;
                   Signal : in Positive := 15);

   --  Get the process exit status.
   function Get_Exit_Status (Proc : in Process) return Integer;

   --  Get the process identifier.
   function Get_Pid (Proc : in Process) return Process_Identifier;

   --  Returns True if the process is running.
   function Is_Running (Proc : in Process) return Boolean;

   --  Get the process input stream allowing to write on the process standard input.
   function Get_Input_Stream (Proc : in Process) return Util.Streams.Output_Stream_Access;

   --  Get the process output stream allowing to read the process standard output.
   function Get_Output_Stream (Proc : in Process) return Util.Streams.Input_Stream_Access;

   --  Get the process error stream allowing to read the process standard output.
   function Get_Error_Stream (Proc : in Process) return Util.Streams.Input_Stream_Access;

private

   type File_Type_Array is array (Positive range <>) of File_Type;
   type File_Type_Array_Access is access all File_Type_Array;

   --  The System_Process interface is specific to the system.  On Unix, it holds the
   --  process identifier.  On Windows, more information is necessary, including the process
   --  and thread handles.  It's a little bit overkill to setup an interface for this but
   --  it looks cleaner than having specific system fields here.
   type System_Process is limited interface;
   type System_Process_Access is access all System_Process'Class;

   type Process is new Ada.Finalization.Limited_Controlled with record
      Pid        : Process_Identifier := -1;
      Sys        : System_Process_Access := null;
      Exit_Value : Integer := -1;
      Dir        : Ada.Strings.Unbounded.Unbounded_String;
      In_File    : Ada.Strings.Unbounded.Unbounded_String;
      Out_File   : Ada.Strings.Unbounded.Unbounded_String;
      Err_File   : Ada.Strings.Unbounded.Unbounded_String;
      Shell      : Ada.Strings.Unbounded.Unbounded_String;
      Out_Append : Boolean := False;
      Err_Append : Boolean := False;
      Output     : Util.Streams.Input_Stream_Access := null;
      Input      : Util.Streams.Output_Stream_Access := null;
      Error      : Util.Streams.Input_Stream_Access := null;
      To_Close   : File_Type_Array_Access;
   end record;

   --  Initialize the process instance.
   overriding
   procedure Initialize (Proc : in out Process);

   --  Deletes the process instance.
   overriding
   procedure Finalize (Proc : in out Process);

   --  Wait for the process to exit.
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration) is abstract;

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15) is abstract;

   --  Spawn a new process.
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE) is abstract;

   --  Clear the program arguments.
   procedure Clear_Arguments (Sys : in out System_Process) is abstract;

   --  Append the argument to the process argument list.
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String) is abstract;

   --  Set the environment variable to be used by the process before its creation.
   procedure Set_Environment (Sys   : in out System_Process;
                              Name  : in String;
                              Value : in String) is abstract;

   --  Set the process input, output and error streams to redirect and use specified files.
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access) is abstract;

   --  Deletes the storage held by the system process.
   procedure Finalize (Sys : in out System_Process) is abstract;

end Util.Processes;

-----------------------------------------------------------------------
--  util-processes -- Process creation and control
--  Copyright (C) 2011, 2012, 2016, 2018, 2021 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;
with Util.Systems.Types;

with Ada.Finalization;
with Ada.Strings.Unbounded;
package Util.Processes is

   Invalid_State : exception;

   Process_Error : exception;

   --  The optional process pipes:
   --

   --
NONE

   --
the process will inherit the standard input, output and error.

   --
READ

   --
a pipe is created to read the process standard output.

   --
READ_ERROR

   --
a pipe is created to read the process standard error.  The output and input are
   --    inherited.

   --
READ_ALL

   --
similar to READ the same pipe is used for the process standard error.

   --
WRITE

   --
a pipe is created to write on the process standard input.

   --
READ_WRITE

   --
Combines the READ and WRITE modes.

   --
READ_WRITE_ALL

   --
Combines the READ_ALL and WRITE modes.

   --

   type Pipe_Mode is (NONE, READ, READ_ERROR, READ_ALL, WRITE, READ_WRITE, READ_WRITE_ALL);

   subtype String_Access is Ada.Strings.Unbounded.String_Access;

   subtype File_Type is Util.Systems.Types.File_Type;

   type Argument_List is array (Positive range <>) of String_Access;

   type Process_Identifier is new Integer;

   --  ------------------------------
   --  Process
   --  ------------------------------
   type Process is limited private;

   --  Before launching the process, redirect the input stream of the process
   --  to the specified file.
   --  Raises Invalid_State if the process is running.
   procedure Set_Input_Stream (Proc : in out Process;
                               File : in String);

   --  Set the output stream of the process.
   --  Raises Invalid_State if the process is running.
   procedure Set_Output_Stream (Proc   : in out Process;
                                File   : in String;
                                Append : in Boolean := False);

   --  Set the error stream of the process.
   --  Raises Invalid_State if the process is running.
   procedure Set_Error_Stream (Proc   : in out Process;
                               File   : in String;
                               Append : in Boolean := False);

   --  Set the working directory that the process will use once it is created.
   --  The directory must exist or the Invalid_Directory exception will be raised.
   procedure Set_Working_Directory (Proc : in out Process;
                                    Path : in String);

   --  Set the shell executable path to use to launch a command.  The default on Unix is
   --  the /bin/sh command.  Argument splitting is done by the /bin/sh -c command.
   --  When setting an empty shell command, the argument splitting is done by the
   --  <tt>Spawn</tt> procedure.
   procedure Set_Shell (Proc  : in out Process;
                        Shell : in String);

   --  Closes the given file descriptor in the child process before executing the command.
   procedure Add_Close (Proc  : in out Process;
                        Fd    : in File_Type);

   --  Append the argument to the current process argument list.
   --  Raises Invalid_State if the process is running.
   procedure Append_Argument (Proc : in out Process;
                              Arg  : in String);

   --  Set the environment variable to be used by the process before its creation.
   procedure Set_Environment (Proc  : in out Process;
                              Name  : in String;
                              Value : in String);

   procedure Set_Environment (Proc    : in out Process;
                              Iterate : not null access
                                procedure
                                  (Process : not null access procedure
                                     (Name  : in String;
                                      Value : in String)));

   --  Spawn a new process with the given command and its arguments.  The standard input, output
   --  and error streams are either redirected to a file or to a stream object.
   procedure Spawn (Proc      : in out Process;
                    Command   : in String;
                    Arguments : in Argument_List;
                    Mode      : in Pipe_Mode := NONE);
   procedure Spawn (Proc      : in out Process;
                    Command   : in String;
                    Mode      : in Pipe_Mode := NONE);
   procedure Spawn (Proc      : in out Process;
                    Mode      : in Pipe_Mode := NONE);

   --  Wait for the process to terminate.
   procedure Wait (Proc : in out Process);

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   procedure Stop (Proc   : in out Process;
                   Signal : in Positive := 15);

   --  Get the process exit status.
   function Get_Exit_Status (Proc : in Process) return Integer;

   --  Get the process identifier.
   function Get_Pid (Proc : in Process) return Process_Identifier;

   --  Returns True if the process is running.
   function Is_Running (Proc : in Process) return Boolean;

   --  Get the process input stream allowing to write on the process standard input.
   function Get_Input_Stream (Proc : in Process) return Util.Streams.Output_Stream_Access;

   --  Get the process output stream allowing to read the process standard output.
   function Get_Output_Stream (Proc : in Process) return Util.Streams.Input_Stream_Access;

   --  Get the process error stream allowing to read the process standard output.
   function Get_Error_Stream (Proc : in Process) return Util.Streams.Input_Stream_Access;

private

   type File_Type_Array is array (Positive range <>) of File_Type;
   type File_Type_Array_Access is access all File_Type_Array;

   --  The System_Process interface is specific to the system.  On Unix, it holds the
   --  process identifier.  On Windows, more information is necessary, including the process
   --  and thread handles.  It's a little bit overkill to setup an interface for this but
   --  it looks cleaner than having specific system fields here.
   type System_Process is limited interface;
   type System_Process_Access is access all System_Process'Class;

   type Process is new Ada.Finalization.Limited_Controlled with record
      Pid        : Process_Identifier := -1;
      Sys        : System_Process_Access := null;
      Exit_Value : Integer := -1;
      Dir        : Ada.Strings.Unbounded.Unbounded_String;
      In_File    : Ada.Strings.Unbounded.Unbounded_String;
      Out_File   : Ada.Strings.Unbounded.Unbounded_String;
      Err_File   : Ada.Strings.Unbounded.Unbounded_String;
      Shell      : Ada.Strings.Unbounded.Unbounded_String;
      Out_Append : Boolean := False;
      Err_Append : Boolean := False;
      Output     : Util.Streams.Input_Stream_Access := null;
      Input      : Util.Streams.Output_Stream_Access := null;
      Error      : Util.Streams.Input_Stream_Access := null;
      To_Close   : File_Type_Array_Access;
   end record;

   --  Initialize the process instance.
   overriding
   procedure Initialize (Proc : in out Process);

   --  Deletes the process instance.
   overriding
   procedure Finalize (Proc : in out Process);

   --  Wait for the process to exit.
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration) is abstract;

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15) is abstract;

   --  Spawn a new process.
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE) is abstract;

   --  Clear the program arguments.
   procedure Clear_Arguments (Sys : in out System_Process) is abstract;

   --  Append the argument to the process argument list.
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String) is abstract;

   --  Set the environment variable to be used by the process before its creation.
   procedure Set_Environment (Sys   : in out System_Process;
                              Name  : in String;
                              Value : in String) is abstract;

   --  Set the process input, output and error streams to redirect and use specified files.
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access) is abstract;

   --  Deletes the storage held by the system process.
   procedure Finalize (Sys : in out System_Process) is abstract;

end Util.Processes;

Add a Spawn procedure

Add a Spawn procedure


-----------------------------------------------------------------------
--  mat-targets - Representation of target information
--  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.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;
with Ada.Finalization;

with GNAT.Sockets;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Events.Targets;
with MAT.Events.Probes;
with MAT.Readers;
with MAT.Readers.Streams;
with MAT.Readers.Streams.Sockets;
with MAT.Consoles;
package MAT.Targets is

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      --  Enable and enter in the interactive TTY console mode.
      Interactive  : Boolean := True;

      --  Try to load the symbol file automatically when a new process is received.
      Load_Symbols : Boolean := True;

      --  Enable the graphical mode (when available).
      Graphical    : Boolean := False;

      --  Print the events as they are received.
      Print_Events : Boolean := False;

      --  Define the server listening address.
      Address      : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   type Target_Process_Type is new Ada.Finalization.Limited_Controlled with record
      Pid     : MAT.Types.Target_Process_Ref;
      Endian  : MAT.Readers.Endian_Type := MAT.Readers.LITTLE_ENDIAN;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols_Ref;
      Events  : MAT.Events.Targets.Target_Events_Access;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   --  Release the target process instance.
   overriding
   procedure Finalize (Target : in out Target_Process_Type);

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Set the console instance.
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access);

   --  Get the current process instance.
   function Process (Target : in Target_Type) return Target_Process_Type_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   overriding
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class));

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out Target_Type);

   --  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);

   --  Start the server to listen to MAT event socket streams.
   procedure Start (Target : in out Target_Type);

   --  Stop the server thread.
   procedure Stop (Target : in out Target_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;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with record
      Current   : Target_Process_Type_Access;
      Processes : Process_Map;
      Console   : MAT.Consoles.Console_Access;
      Options   : Options_Type;
      Server    : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   end record;

   --  Release the storage used by the target object.
   overriding
   procedure Finalize (Target : in out Target_Type);

end MAT.Targets;

-----------------------------------------------------------------------
--  mat-targets - Representation of target information
--  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.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;
with Ada.Finalization;

with GNAT.Sockets;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Events.Targets;
with MAT.Events.Probes;
with MAT.Readers;
with MAT.Readers.Streams;
with MAT.Readers.Streams.Sockets;
with MAT.Consoles;
with MAT.Expressions;
package MAT.Targets is

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      --  Enable and enter in the interactive TTY console mode.
      Interactive  : Boolean := True;

      --  Try to load the symbol file automatically when a new process is received.
      Load_Symbols : Boolean := True;

      --  Enable the graphical mode (when available).
      Graphical    : Boolean := False;

      --  Print the events as they are received.
      Print_Events : Boolean := False;

      --  Define the server listening address.
      Address      : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   type Target_Process_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Expressions.Resolver_Type with record
      Pid     : MAT.Types.Target_Process_Ref;
      Endian  : MAT.Readers.Endian_Type := MAT.Readers.LITTLE_ENDIAN;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols_Ref;
      Events  : MAT.Events.Targets.Target_Events_Access;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   --  Release the target process instance.
   overriding
   procedure Finalize (Target : in out Target_Process_Type);

   --  Find the region that matches the given name.
   overriding
   function Find_Region (Resolver : in Target_Process_Type;
                         Name     : in String) return MAT.Memory.Region_Info;

   --  Find the symbol in the symbol table and return the start and end address.
   overriding
   function Find_Symbol (Resolver : in Target_Process_Type;
                         Name     : in String) return MAT.Memory.Region_Info;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Set the console instance.
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access);

   --  Get the current process instance.
   function Process (Target : in Target_Type) return Target_Process_Type_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   overriding
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class));

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out Target_Type);

   --  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);

   --  Start the server to listen to MAT event socket streams.
   procedure Start (Target : in out Target_Type);

   --  Stop the server thread.
   procedure Stop (Target : in out Target_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;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with record
      Current   : Target_Process_Type_Access;
      Processes : Process_Map;
      Console   : MAT.Consoles.Console_Access;
      Options   : Options_Type;
      Server    : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   end record;

   --  Release the storage used by the target object.
   overriding
   procedure Finalize (Target : in out Target_Type);

end MAT.Targets;

Change Target_Process_Type to implement the Resolver_Type interface


-----------------------------------------------------------------------
--  mat-callbacks - Callbacks for Gtk
--  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.Types;
with Gtkada.Builder;
package MAT.Callbacks is

   --  Callback executed when the "quit" action is executed from the menu.
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

end MAT.Callbacks;

-----------------------------------------------------------------------
--  mat-callbacks - Callbacks for Gtk
--  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.Types;
with Gtkada.Builder;
package MAT.Callbacks is

   --  Callback executed when the "quit" action is executed from the menu.
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "about" action is executed from the menu.
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

end MAT.Callbacks;

Declare the On_Menu_About procedure

Declare the On_Menu_About procedure