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

with ASF.Events.Phases;
with ASF.Components.Base;
with ASF.Events.Faces.Actions;
with ASF.Applications.Main;

package body ASF.Components.Core.Views is

   use ASF;
   use EL.Objects;
   use type Base.UIComponent_Access;

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => ASF.Events.Faces.Faces_Event'Class,
                                     Name   => Faces_Event_Access);

   --  ------------------------------
   --  Get the content type returned by the view.
   --  ------------------------------
   function Get_Content_Type (UI      : in UIView;
                              Context : in Faces_Context'Class) return String is
   begin
      if Util.Beans.Objects.Is_Null (UI.Content_Type) then
         return UI.Get_Attribute (Name => "contentType", Context => Context);
      else
         return Util.Beans.Objects.To_String (UI.Content_Type);
      end if;
   end Get_Content_Type;

   --  ------------------------------
   --  Set the content type returned by the view.
   --  ------------------------------
   procedure Set_Content_Type (UI     : in out UIView;
                               Value  : in String) is
   begin
      UI.Content_Type := Util.Beans.Objects.To_Object (Value);
   end Set_Content_Type;

   --  ------------------------------
   --  Get the locale to be used when rendering messages in the view.
   --  If a locale was set explicitly, return it.
   --  If the view component defines a locale attribute, evaluate and return its value.
   --  If the locale is empty, calculate the locale by using the request context and the view
   --  handler.
   --  ------------------------------
   function Get_Locale (UI      : in UIView;
                        Context : in Faces_Context'Class) return Util.Locales.Locale is
      use type Util.Locales.Locale;
   begin
      if UI.Locale /= Util.Locales.NULL_LOCALE then
         return UI.Locale;
      end if;
      declare
         Value : constant Util.Beans.Objects.Object := UI.Get_Attribute (Name    => "locale",
                                                                         Context => Context);
      begin
         --  If the root view does not specify any locale, calculate it from the request.
         if Util.Beans.Objects.Is_Null (Value) then
            return Context.Get_Application.Get_View_Handler.Calculate_Locale (Context);
         end if;

         --  Resolve the locale.  If it is not valid, calculate it from the request.
         declare
            Name   : constant String := Util.Beans.Objects.To_String (Value);
            Locale : constant Util.Locales.Locale := Util.Locales.Get_Locale (Name);
         begin
            if Locale /= Util.Locales.NULL_LOCALE then
               return Locale;
            else
               return Context.Get_Application.Get_View_Handler.Calculate_Locale (Context);
            end if;
         end;
      end;
   end Get_Locale;

   --  ------------------------------
   --  Set the locale to be used when rendering messages in the view.
   --  ------------------------------
   procedure Set_Locale (UI     : in out UIView;
                         Locale : in Util.Locales.Locale) is
   begin
      UI.Locale := Locale;
   end Set_Locale;

   --  ------------------------------
   --  Encode the begining of the view.  Set the response content type.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIView;
                           Context : in out Faces_Context'Class) is
      Content_Type : constant String := UI.Get_Content_Type (Context => Context);
   begin
      Context.Get_Response.Set_Content_Type (Content_Type);
      if UI.Left_Tree /= null then
         UI.Left_Tree.Encode_All (Context);
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Encode the end of the view.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIView;
                         Context : in out Faces_Context'Class) is
   begin
      if UI.Right_Tree /= null then
         UI.Right_Tree.Encode_All (Context);
      end if;
   end Encode_End;

   --  ------------------------------
   --  Decode any new state of the specified component from the request contained
   --  in the specified context and store that state on the component.
   --
   --  During decoding, events may be enqueued for later processing
   --  (by event listeners that have registered an interest), by calling
   --  the Queue_Event on the associated component.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Decodes (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.APPLY_REQUEST_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Decodes;

   --  ------------------------------
   --  Perform the component tree processing required by the Process Validations
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows:
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Validators of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Validators (UI      : in out UIView;
                                 Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Validators (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.PROCESS_VALIDATION, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Validators;

   --  ------------------------------
   --  Perform the component tree processing required by the Update Model Values
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows.
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Updates/b> of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Updates (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Updates (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.UPDATE_MODEL_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Updates;

   --  ------------------------------
   --  Broadcast any events that have been queued for the Invoke Application
   --  phase of the request processing lifecycle and to clear out any events
   --  for later phases if the event processing for this phase caused
   --  renderResponse or responseComplete to be called.
   --  ------------------------------
   procedure Process_Application (UI      : in out UIView;
                                  Context : in out Faces_Context'Class) is
   begin
      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.INVOKE_APPLICATION, Context);
   end Process_Application;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   procedure Queue_Event (UI    : in out UIView;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         Parent.Queue_Event (Event);
      else
         UI.Phase_Events (Event.Get_Phase).Append (Event.all'Access);
      end if;
   end Queue_Event;

   --  ------------------------------
   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   --  ------------------------------
   procedure Broadcast (UI      : in out UIView;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is

      Pos : Natural := 0;

      --  Broadcast the event to the component's listeners
      --  and free that event.
      procedure Broadcast (Ev : in out Faces_Event_Access);

      procedure Broadcast (Ev : in out Faces_Event_Access) is
      begin
         if Ev /= null then
            declare
               C  : constant Base.UIComponent_Access := Ev.Get_Component;
            begin
               C.Broadcast (Ev, Context);
            end;
            Free (Ev);
         end if;
      end Broadcast;

      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         UIView'Class (Parent.all).Broadcast (Phase, Context);
      else
         --  Dispatch events in the order in which they were queued.
         --  More events could be queued as a result of the dispatch.
         --  After dispatching an event, it is freed but not removed
         --  from the event queue (the access will be cleared).
         loop
            exit when Pos > UI.Phase_Events (Phase).Last_Index;
            UI.Phase_Events (Phase).Update_Element (Pos, Broadcast'Access);
            Pos := Pos + 1;
         end loop;

         --  Now, clear the queue.
         UI.Phase_Events (Phase).Clear;
      end if;
   end Broadcast;

   --  ------------------------------
   --  Clear the events that were queued.
   --  ------------------------------
   procedure Clear_Events (UI : in out UIView) is
   begin
      for Phase in UI.Phase_Events'Range loop
         for I in 0 .. UI.Phase_Events (Phase).Last_Index loop
            declare
               Ev : Faces_Event_Access := UI.Phase_Events (Phase).Element (I);
            begin
               Free (Ev);
            end;
         end loop;
         UI.Phase_Events (Phase).Clear;
      end loop;
   end Clear_Events;

   --  ------------------------------
   --  Set the component tree that must be rendered before this view.
   --  This is an internal method used by Steal_Root_Component exclusively.
   --  ------------------------------
   procedure Set_Before_View (UI   : in out UIView'Class;
                              Tree : in Base.UIComponent_Access) is
   begin
      if UI.Left_Tree /= null then
         UI.Log_Error ("Set_Before_View called while there is a tree");
      end if;
      UI.Left_Tree := Tree;
   end Set_Before_View;

   --  ------------------------------
   --  Set the component tree that must be rendered after this view.
   --  This is an internal method used by Steal_Root_Component exclusively.
   --  ------------------------------
   procedure Set_After_View (UI   : in out UIView'Class;
                             Tree : in Base.UIComponent_Access) is
   begin
      if UI.Right_Tree /= null then
         UI.Log_Error ("Set_Before_View called while there is a tree");
      end if;
      UI.Right_Tree := Tree;
   end Set_After_View;

   --  ------------------------------
   --  Finalize the object.
   --  ------------------------------
   overriding
   procedure Finalize (UI : in out UIView) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Base.UIComponent'Class,
                                        Name   => Base.UIComponent_Access);

   begin
      Free (UI.Left_Tree);
      Free (UI.Right_Tree);
      Base.UIComponent (UI).Finalize;
   end Finalize;

   --  ------------------------------
   --  Set the metadata facet on the UIView component.
   --  ------------------------------
   procedure Set_Metadata (UI    : in out UIView;
                           Meta  : in UIViewMetaData_Access;
                           Tag   : access ASF.Views.Nodes.Tag_Node'Class) is
   begin
      if UI.Meta /= null then
         UI.Log_Error ("A <f:metadata> component was already registered.");
--           Delete (UI.Meta);
      end if;
      Meta.Root := UI'Unchecked_Access;
      UI.Meta := Meta;
      UI.Add_Facet (METADATA_FACET_NAME, Meta.all'Access, Tag);
   end Set_Metadata;

   --  ------------------------------
   --  Decode the request and prepare for the execution for the view action.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIViewAction;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      begin
         ASF.Events.Faces.Actions.Post_Event (UI     => UI,
                                              Method => UI.Get_Action_Expression (Context));

      exception
         when EL.Expressions.Invalid_Expression =>
            null;
      end;
   end Process_Decodes;

   --  ------------------------------
   --  Get the root component.
   --  ------------------------------
   function Get_Root (UI      : in UIViewMetaData) return Base.UIComponent_Access is
      Result : Base.UIComponent_Access := UI.Get_Parent;
      Parent : Base.UIComponent_Access := Result.Get_Parent;
   begin
      while Parent /= null loop
         Result := Parent;
         Parent := Parent.Get_Parent;
      end loop;
      return Result;
   end Get_Root;

   --  ------------------------------
   --  Start encoding the UIComponent.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIViewMetaData;
                           Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_Begin (Context);
   end Encode_Begin;

   --  ------------------------------
   --  Encode the children of this component.
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIViewMetaData;
                              Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_Children (Context);
   end Encode_Children;

   --  ------------------------------
   --  Finish encoding the component.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIViewMetaData;
                         Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_End (Context);
   end Encode_End;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   overriding
   procedure Queue_Event (UI    : in out UIViewMetaData;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
   begin
      UI.Root.Queue_Event (Event);
   end Queue_Event;

   --  ------------------------------
   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   --  ------------------------------
   overriding
   procedure Broadcast (UI      : in out UIViewMetaData;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is
   begin
      UI.Root.Broadcast (Phase, Context);
   end Broadcast;

   --  ------------------------------
   --  Clear the events that were queued.
   --  ------------------------------
   overriding
   procedure Clear_Events (UI : in out UIViewMetaData) is
   begin
      UI.Root.Clear_Events;
   end Clear_Events;

end ASF.Components.Core.Views;

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

with ASF.Events.Phases;
with ASF.Components.Base;
with ASF.Events.Faces.Actions;
with ASF.Applications.Main;

package body ASF.Components.Core.Views is

   use ASF;
   use EL.Objects;
   use type Base.UIComponent_Access;

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => ASF.Events.Faces.Faces_Event'Class,
                                     Name   => Faces_Event_Access);

   --  ------------------------------
   --  Get the content type returned by the view.
   --  ------------------------------
   function Get_Content_Type (UI      : in UIView;
                              Context : in Faces_Context'Class) return String is
   begin
      if Util.Beans.Objects.Is_Null (UI.Content_Type) then
         return UI.Get_Attribute (Name => "contentType", Context => Context);
      else
         return Util.Beans.Objects.To_String (UI.Content_Type);
      end if;
   end Get_Content_Type;

   --  ------------------------------
   --  Set the content type returned by the view.
   --  ------------------------------
   procedure Set_Content_Type (UI     : in out UIView;
                               Value  : in String) is
   begin
      UI.Content_Type := Util.Beans.Objects.To_Object (Value);
   end Set_Content_Type;

   --  ------------------------------
   --  Get the locale to be used when rendering messages in the view.
   --  If a locale was set explicitly, return it.
   --  If the view component defines a locale attribute, evaluate and return its value.
   --  If the locale is empty, calculate the locale by using the request context and the view
   --  handler.
   --  ------------------------------
   function Get_Locale (UI      : in UIView;
                        Context : in Faces_Context'Class) return Util.Locales.Locale is
      use type Util.Locales.Locale;
   begin
      if UI.Locale /= Util.Locales.NULL_LOCALE then
         return UI.Locale;
      end if;
      declare
         Value : constant Util.Beans.Objects.Object := UI.Get_Attribute (Name    => "locale",
                                                                         Context => Context);
      begin
         --  If the root view does not specify any locale, calculate it from the request.
         if Util.Beans.Objects.Is_Null (Value) then
            return Context.Get_Application.Get_View_Handler.Calculate_Locale (Context);
         end if;

         --  Resolve the locale.  If it is not valid, calculate it from the request.
         declare
            Name   : constant String := Util.Beans.Objects.To_String (Value);
            Locale : constant Util.Locales.Locale := Util.Locales.Get_Locale (Name);
         begin
            if Locale /= Util.Locales.NULL_LOCALE then
               return Locale;
            else
               return Context.Get_Application.Get_View_Handler.Calculate_Locale (Context);
            end if;
         end;
      end;
   end Get_Locale;

   --  ------------------------------
   --  Set the locale to be used when rendering messages in the view.
   --  ------------------------------
   procedure Set_Locale (UI     : in out UIView;
                         Locale : in Util.Locales.Locale) is
   begin
      UI.Locale := Locale;
   end Set_Locale;

   --  ------------------------------
   --  Encode the begining of the view.  Set the response content type.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIView;
                           Context : in out Faces_Context'Class) is
      Content_Type : constant String := UI.Get_Content_Type (Context => Context);
   begin
      Context.Get_Response.Set_Content_Type (Content_Type);
      if UI.Left_Tree /= null then
         UI.Left_Tree.Encode_All (Context);
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Encode the end of the view.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIView;
                         Context : in out Faces_Context'Class) is
   begin
      if UI.Right_Tree /= null then
         UI.Right_Tree.Encode_All (Context);
      end if;
   end Encode_End;

   --  ------------------------------
   --  Decode any new state of the specified component from the request contained
   --  in the specified context and store that state on the component.
   --
   --  During decoding, events may be enqueued for later processing
   --  (by event listeners that have registered an interest), by calling
   --  the Queue_Event on the associated component.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Decodes (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.APPLY_REQUEST_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Decodes;

   --  ------------------------------
   --  Perform the component tree processing required by the Process Validations
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows:
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Validators of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Validators (UI      : in out UIView;
                                 Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Validators (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.PROCESS_VALIDATION, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Validators;

   --  ------------------------------
   --  Perform the component tree processing required by the Update Model Values
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows.
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Updates/b> of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Updates (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Updates (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.UPDATE_MODEL_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Updates;

   --  ------------------------------
   --  Broadcast any events that have been queued for the Invoke Application
   --  phase of the request processing lifecycle and to clear out any events
   --  for later phases if the event processing for this phase caused
   --  renderResponse or responseComplete to be called.
   --  ------------------------------
   procedure Process_Application (UI      : in out UIView;
                                  Context : in out Faces_Context'Class) is
   begin
      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.INVOKE_APPLICATION, Context);
   end Process_Application;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   procedure Queue_Event (UI    : in out UIView;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         Parent.Queue_Event (Event);
      else
         UI.Phase_Events (Event.Get_Phase).Append (Event.all'Access);
      end if;
   end Queue_Event;

   --  ------------------------------
   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   --  ------------------------------
   procedure Broadcast (UI      : in out UIView;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is

      Pos : Natural := 0;

      --  Broadcast the event to the component's listeners
      --  and free that event.
      procedure Broadcast (Ev : in out Faces_Event_Access);

      procedure Broadcast (Ev : in out Faces_Event_Access) is
      begin
         if Ev /= null then
            declare
               C  : constant Base.UIComponent_Access := Ev.Get_Component;
            begin
               C.Broadcast (Ev, Context);
            end;
            Free (Ev);
         end if;
      end Broadcast;

      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         UIView'Class (Parent.all).Broadcast (Phase, Context);
      else
         --  Dispatch events in the order in which they were queued.
         --  More events could be queued as a result of the dispatch.
         --  After dispatching an event, it is freed but not removed
         --  from the event queue (the access will be cleared).
         loop
            exit when Pos > UI.Phase_Events (Phase).Last_Index;
            UI.Phase_Events (Phase).Update_Element (Pos, Broadcast'Access);
            Pos := Pos + 1;
         end loop;

         --  Now, clear the queue.
         UI.Phase_Events (Phase).Clear;
      end if;
   end Broadcast;

   --  ------------------------------
   --  Clear the events that were queued.
   --  ------------------------------
   procedure Clear_Events (UI : in out UIView) is
   begin
      for Phase in UI.Phase_Events'Range loop
         for I in 0 .. UI.Phase_Events (Phase).Last_Index loop
            declare
               Ev : Faces_Event_Access := UI.Phase_Events (Phase).Element (I);
            begin
               Free (Ev);
            end;
         end loop;
         UI.Phase_Events (Phase).Clear;
      end loop;
   end Clear_Events;

   --  ------------------------------
   --  Set the component tree that must be rendered before this view.
   --  This is an internal method used by Steal_Root_Component exclusively.
   --  ------------------------------
   procedure Set_Before_View (UI   : in out UIView'Class;
                              Tree : in Base.UIComponent_Access) is
   begin
      if UI.Left_Tree /= null then
         UI.Log_Error ("Set_Before_View called while there is a tree");
      end if;
      UI.Left_Tree := Tree;
   end Set_Before_View;

   --  ------------------------------
   --  Set the component tree that must be rendered after this view.
   --  This is an internal method used by Steal_Root_Component exclusively.
   --  ------------------------------
   procedure Set_After_View (UI   : in out UIView'Class;
                             Tree : in Base.UIComponent_Access) is
   begin
      if UI.Right_Tree /= null then
         UI.Log_Error ("Set_Before_View called while there is a tree");
      end if;
      UI.Right_Tree := Tree;
   end Set_After_View;

   --  ------------------------------
   --  Finalize the object.
   --  ------------------------------
   overriding
   procedure Finalize (UI : in out UIView) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Base.UIComponent'Class,
                                        Name   => Base.UIComponent_Access);

   begin
      Free (UI.Left_Tree);
      Free (UI.Right_Tree);
      Base.UIComponent (UI).Finalize;
   end Finalize;

   --  ------------------------------
   --  Set the metadata facet on the UIView component.
   --  ------------------------------
   procedure Set_Metadata (UI    : in out UIView;
                           Meta  : in UIViewMetaData_Access;
                           Tag   : access ASF.Views.Nodes.Tag_Node'Class) is
   begin
      if UI.Meta /= null then
         UI.Log_Error ("A <f:metadata> component was already registered.");
--           Delete (UI.Meta);
      end if;
      Meta.Root := UI'Unchecked_Access;
      UI.Meta := Meta;
      UI.Add_Facet (METADATA_FACET_NAME, Meta.all'Access, Tag);
   end Set_Metadata;

   --  ------------------------------
   --  Get the input parameter from the submitted context.  This operation is called by
   --  <tt>Process_Decodes</tt> to retrieve the request parameter associated with the component.
   --  ------------------------------
   overriding
   function Get_Parameter (UI      : in UIViewParameter;
                           Context : in Faces_Context'Class) return String is
      Name : constant String := UI.Get_Attribute ("name", Context);
   begin
      if Name'Length > 0 then
         return Context.Get_Parameter (Name);
      else
         return Html.Forms.UIInput (UI).Get_Parameter (Context);
      end if;
   end Get_Parameter;

   --  ------------------------------
   --  Decode the request and prepare for the execution for the view action.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIViewAction;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      begin
         ASF.Events.Faces.Actions.Post_Event (UI     => UI,
                                              Method => UI.Get_Action_Expression (Context));

      exception
         when EL.Expressions.Invalid_Expression =>
            null;
      end;
   end Process_Decodes;

   --  ------------------------------
   --  Get the root component.
   --  ------------------------------
   function Get_Root (UI      : in UIViewMetaData) return Base.UIComponent_Access is
      Result : Base.UIComponent_Access := UI.Get_Parent;
      Parent : Base.UIComponent_Access := Result.Get_Parent;
   begin
      while Parent /= null loop
         Result := Parent;
         Parent := Parent.Get_Parent;
      end loop;
      return Result;
   end Get_Root;

   --  ------------------------------
   --  Start encoding the UIComponent.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIViewMetaData;
                           Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_Begin (Context);
   end Encode_Begin;

   --  ------------------------------
   --  Encode the children of this component.
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIViewMetaData;
                              Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_Children (Context);
   end Encode_Children;

   --  ------------------------------
   --  Finish encoding the component.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIViewMetaData;
                         Context : in out Faces_Context'Class) is
   begin
      UI.Get_Root.Encode_End (Context);
   end Encode_End;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   overriding
   procedure Queue_Event (UI    : in out UIViewMetaData;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
   begin
      UI.Root.Queue_Event (Event);
   end Queue_Event;

   --  ------------------------------
   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   --  ------------------------------
   overriding
   procedure Broadcast (UI      : in out UIViewMetaData;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is
   begin
      UI.Root.Broadcast (Phase, Context);
   end Broadcast;

   --  ------------------------------
   --  Clear the events that were queued.
   --  ------------------------------
   overriding
   procedure Clear_Events (UI : in out UIViewMetaData) is
   begin
      UI.Root.Clear_Events;
   end Clear_Events;

end ASF.Components.Core.Views;

Implement the Get_Parameter function to support the <f:viewParam> name attribute


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "42";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "43";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

Bump to version v1.43

Bump to version v1.43


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "1";
   raven_version_minor : constant String := "13";
   copyright_years     : constant String := "2015-2018";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-5.7";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.28";
   default_pgsql     : constant String := "10";
   default_php       : constant String := "7.2";
   default_python3   : constant String := "3.7";
   default_ruby      : constant String := "2.5";
   default_tcltk     : constant String := "8.6";
   default_firebird  : constant String := "2.5";
   default_compiler  : constant String := "gcc8";
   compiler_version  : constant String := "8.2.0";
   previous_compiler : constant String := "7.3.0";
   binutils_version  : constant String := "2.31.1";
   previous_binutils : constant String := "2.30";
   arc_ext           : constant String := ".tzst";
   jobs_per_cpu      : constant := 2;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   raven_var      : constant String := "/var/ravenports";
   host_pkg8      : constant String := host_localbase & "/sbin/pkg-static";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "1";
   raven_version_minor : constant String := "14";
   copyright_years     : constant String := "2015-2018";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-5.7";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.28";
   default_pgsql     : constant String := "10";
   default_php       : constant String := "7.2";
   default_python3   : constant String := "3.7";
   default_ruby      : constant String := "2.5";
   default_tcltk     : constant String := "8.6";
   default_firebird  : constant String := "2.5";
   default_compiler  : constant String := "gcc8";
   compiler_version  : constant String := "8.2.0";
   previous_compiler : constant String := "7.3.0";
   binutils_version  : constant String := "2.31.1";
   previous_binutils : constant String := "2.30";
   arc_ext           : constant String := ".tzst";
   jobs_per_cpu      : constant := 2;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   raven_var      : constant String := "/var/ravenports";
   host_pkg8      : constant String := host_localbase & "/sbin/pkg-static";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

Bump version for php/postgresql changes

Bump version for php/postgresql changes


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

--  = Files =
--  The `Util.Files` package provides various utility operations arround files
--  to help in reading, writing, searching for files in a path.
--  To use the operations described here, use the following GNAT project:
--
--    with "utilada_base";
--
--  == Reading and writing ==
--  To easily get the full content of a file, the `Read_File` procedure can be
--  used.  A first form exists that populates a `Unbounded_String` or a vector
--  of strings.  A second form exists with a procedure that is called with each
--  line while the file is read.  These different forms simplify the reading of
--  files as it is possible to write:
--
--    Content : Ada.Strings.Unbounded.Unbounded_String;
--    Util.Files.Read_File ("config.txt", Content);
--
--  or
--
--    List : Util.Strings.Vectors.Vector;
--    Util.Files.Read_File ("config.txt", List);
--
--  or
--
--    procedure Read_Line (Line : in String) is ...
--    Util.Files.Read_File ("config.txt", Read_Line'Access);
--
--  Similarly, writing a file when you have a string or an `Unbounded_String`
--  is easily written by using `Write_File` as follows:
--
--    Util.Files.Write_File ("config.txt", "full content");
--
--  == Searching files ==
--  Searching for a file in a list of directories can be accomplished by using
--  the `Iterate_Path`, `Iterate_Files_Path` or `Find_File_Path`.
--
--  The `Find_File_Path` function is helpful to find a file in some `PATH`
--  search list.  The function looks in each search directory for the given
--  file name and it builds and returns the computed path of the first file
--  found in the search list.  For example:
--
--    Path : String := Util.Files.Find_File_Path ("ls",
--                                                "/bin:/usr/bin",
--                                                ':');
--
--  This will return `/usr/bin/ls` on most Unix systems.
--
--  @include util-files-rolling.ads
package Util.Files is

   use Ada.Strings.Unbounded;

   subtype Direction is Ada.Strings.Direction;

   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0);

   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String));

   --  Read the file with the given path, one line at a time and append each line to
   --  the Into vector.
   procedure Read_File (Path  : in String;
                        Into  : in out Util.Strings.Vectors.Vector);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in String);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String);

   --  Iterate over the search directories defined in Path and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward);

   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward);

   --  Find the file `Name` in one of the search directories defined in `Paths`.
   --  Each search directory is separated by ';' by default (yes, even on Unix).
   --  This can be changed by specifying the `Separator` value.
   --  Returns the path to be used for reading the file.
   function Find_File_Path (Name      : in String;
                            Paths     : in String;
                            Separator : in Character := ';') return String;

   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map);

   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   function Compose (Directory : in String;
                     Name      : in String) return String;

   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';' (this can be overriding with the `Separator` parameter).
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   function Compose_Path (Paths     : in String;
                          Name      : in String;
                          Separator : in Character := ';') return String;

   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute paths.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   function Get_Relative_Path (From : in String;
                               To   : in String) return String;

   --  Rename the old name into a new name.
   procedure Rename (Old_Name, New_Name : in String);

   --  Delete the file including missing symbolic link
   --  or socket files (which GNAT fails to delete,
   --  see gcc/63222 and gcc/56055).  The function returns 0
   --  or the system error code.  The procedure raises the Use_Error
   --  exception if the file cannot be deleted.
   function Delete_File (Path : in String) return Integer;
   procedure Delete_File (Path : in String);

   --  Delete the directory tree recursively.  If the directory tree contains
   --  sockets, special files and dangling symbolic links, they are removed
   --  correctly.  This is a workarround for GNAT bug gcc/63222 and gcc/56055.
   procedure Delete_Tree (Path : in String);

end Util.Files;

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

--  = Files =
--  The `Util.Files` package provides various utility operations arround files
--  to help in reading, writing, searching for files in a path.
--  To use the operations described here, use the following GNAT project:
--
--    with "utilada_base";
--
--  == Reading and writing ==
--  To easily get the full content of a file, the `Read_File` procedure can be
--  used.  A first form exists that populates a `Unbounded_String` or a vector
--  of strings.  A second form exists with a procedure that is called with each
--  line while the file is read.  These different forms simplify the reading of
--  files as it is possible to write:
--
--    Content : Ada.Strings.Unbounded.Unbounded_String;
--    Util.Files.Read_File ("config.txt", Content);
--
--  or
--
--    List : Util.Strings.Vectors.Vector;
--    Util.Files.Read_File ("config.txt", List);
--
--  or
--
--    procedure Read_Line (Line : in String) is ...
--    Util.Files.Read_File ("config.txt", Read_Line'Access);
--
--  Similarly, writing a file when you have a string or an `Unbounded_String`
--  is easily written by using `Write_File` as follows:
--
--    Util.Files.Write_File ("config.txt", "full content");
--
--  == Searching files ==
--  Searching for a file in a list of directories can be accomplished by using
--  the `Iterate_Path`, `Iterate_Files_Path` or `Find_File_Path`.
--
--  The `Find_File_Path` function is helpful to find a file in some `PATH`
--  search list.  The function looks in each search directory for the given
--  file name and it builds and returns the computed path of the first file
--  found in the search list.  For example:
--
--    Path : String := Util.Files.Find_File_Path ("ls",
--                                                "/bin:/usr/bin",
--                                                ':');
--
--  This will return `/usr/bin/ls` on most Unix systems.
--
--  @include util-files-rolling.ads
package Util.Files is

   use Ada.Strings.Unbounded;

   subtype Direction is Ada.Strings.Direction;

   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0);

   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String));

   --  Read the file with the given path, one line at a time and append each line to
   --  the Into vector.
   procedure Read_File (Path  : in String;
                        Into  : in out Util.Strings.Vectors.Vector);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in String);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String);

   --  Iterate over the search directories defined in Path and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward);

   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward);

   --  Find the file `Name` in one of the search directories defined in `Paths`.
   --  Each search directory is separated by ';' by default (yes, even on Unix).
   --  This can be changed by specifying the `Separator` value.
   --  Returns the path to be used for reading the file.
   function Find_File_Path (Name      : in String;
                            Paths     : in String;
                            Separator : in Character := ';') return String;

   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map);

   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   function Compose (Directory : in String;
                     Name      : in String) return String;

   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';' (this can be overriding with the `Separator` parameter).
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   function Compose_Path (Paths     : in String;
                          Name      : in String;
                          Separator : in Character := ';') return String;

   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute paths.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   function Get_Relative_Path (From : in String;
                               To   : in String) return String;

   --  Rename the old name into a new name.
   procedure Rename (Old_Name, New_Name : in String);

   --  Delete the file including missing symbolic link
   --  or socket files (which GNAT fails to delete,
   --  see gcc/63222 and gcc/56055).  The function returns 0
   --  or the system error code.  The procedure raises the Use_Error
   --  exception if the file cannot be deleted.
   function Delete_File (Path : in String) return Integer;
   procedure Delete_File (Path : in String);

   --  Delete the directory tree recursively.  If the directory tree contains
   --  sockets, special files and dangling symbolic links, they are removed
   --  correctly.  This is a workarround for GNAT bug gcc/63222 and gcc/56055.
   procedure Delete_Tree (Path : in String);

   --  Find the canonicalized absolute path of the given file.
   function Realpath (Path : in String) return String;

end Util.Files;

Declare the Realpath function to give access to realpath (3) or GetFullPathNameW()


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

with Util.Strings;
with MAT.Formats;
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.Formats.Addr (Addr);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Field;

   --  ------------------------------
   --  Format the address range and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          From    : in MAT.Types.Target_Addr;
                          To      : in MAT.Types.Target_Addr) is
      From_Value : constant String := MAT.Formats.Addr (From);
      To_Value   : constant String := MAT.Formats.Addr (To);
   begin
      Console_Type'Class (Console).Print_Field (Field, From_Value & "-" & To_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.Formats.Size (Size);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Size;

   --  ------------------------------
   --  Format the thread information and print it for the given field.
   --  ------------------------------
   procedure Print_Thread (Console : in out Console_Type;
                           Field   : in Field_Type;
                           Thread  : in MAT.Types.Target_Thread_Ref) is
      Value : constant String := MAT.Types.Target_Thread_Ref'Image (Thread);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Thread;

   --  ------------------------------
   --  Format the time tick as a duration and print it for the given field.
   --  ------------------------------
   procedure Print_Duration (Console  : in out Console_Type;
                             Field    : in Field_Type;
                             Duration : in MAT.Types.Target_Tick_Ref) is
      Value : constant String := MAT.Formats.Duration (Duration);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Duration;

   --  ------------------------------
   --  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;
                          Justify : in Justify_Type := J_LEFT) is
      Val : constant String := Util.Strings.Image (Value);
   begin
      Console_Type'Class (Console).Print_Field (Field, Val, Justify);
   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;
                          Justify : in Justify_Type := J_LEFT) is
      Item : String := Ada.Strings.Unbounded.To_String (Value);
      Size : constant Natural := Console.Sizes (Field);
   begin
      if Size <= Item'Length then
         Item (Item'Last - Size + 2 .. Item'Last - Size + 4) := "...";
         Console_Type'Class (Console).Print_Field (Field,
                                                   Item (Item'Last - Size + 2 .. Item'Last));
      else
         Console_Type'Class (Console).Print_Field (Field, Item, Justify);
      end if;
   end Print_Field;

   --  ------------------------------
   --  Get the field count that was setup through the Print_Title calls.
   --  ------------------------------
   function Get_Field_Count (Console : in Console_Type) return Natural is
   begin
      return Console.Field_Count;
   end Get_Field_Count;

end MAT.Consoles;

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

with Util.Strings;
with MAT.Formats;
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.Formats.Addr (Addr);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Field;

   --  ------------------------------
   --  Format the address range and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          From    : in MAT.Types.Target_Addr;
                          To      : in MAT.Types.Target_Addr) is
      From_Value : constant String := MAT.Formats.Addr (From);
      To_Value   : constant String := MAT.Formats.Addr (To);
   begin
      Console_Type'Class (Console).Print_Field (Field, From_Value & "-" & To_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.Formats.Size (Size);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Size;

   --  ------------------------------
   --  Format the thread information and print it for the given field.
   --  ------------------------------
   procedure Print_Thread (Console : in out Console_Type;
                           Field   : in Field_Type;
                           Thread  : in MAT.Types.Target_Thread_Ref) is
      Value : constant String := MAT.Types.Target_Thread_Ref'Image (Thread);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Thread;

   --  ------------------------------
   --  Format the time tick as a duration and print it for the given field.
   --  ------------------------------
   procedure Print_Duration (Console  : in out Console_Type;
                             Field    : in Field_Type;
                             Duration : in MAT.Types.Target_Tick_Ref) is
      Value : constant String := MAT.Formats.Duration (Duration);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Duration;

   --  ------------------------------
   --  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;
                          Justify : in Justify_Type := J_LEFT) is
      Val : constant String := Util.Strings.Image (Value);
   begin
      Console_Type'Class (Console).Print_Field (Field, Val, Justify);
   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;
                          Justify : in Justify_Type := J_LEFT) is
      Item : String := Ada.Strings.Unbounded.To_String (Value);
      Size : constant Natural := Console.Sizes (Field);
   begin
      if Size <= Item'Length then
         Item (Item'Last - Size + 2 .. Item'Last - Size + 4) := "...";
         Console_Type'Class (Console).Print_Field (Field,
                                                   Item (Item'Last - Size + 2 .. Item'Last));
      else
         Console_Type'Class (Console).Print_Field (Field, Item, Justify);
      end if;
   end Print_Field;

   --  ------------------------------
   --  Get the field count that was setup through the Print_Title calls.
   --  ------------------------------
   function Get_Field_Count (Console : in Console_Type) return Natural is
   begin
      return Console.Field_Count;
   end Get_Field_Count;

   --  ------------------------------
   --  Reset the field count.
   --  ------------------------------
   procedure Clear_Fields (Console : in out Console_Type) is
   begin
      Console.Field_Count := 0;
   end Clear_Fields;

end MAT.Consoles;

Implement the Clear_Fields procedure

Implement the Clear_Fields procedure


------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.Smaz_Implementations.Base_64 is

   package Tools renames Natools.Smaz_Implementations.Base_64_Tools;

   use type Ada.Streams.Stream_Element_Offset;
   use type Tools.Base_64_Digit;

   ----------------------
   -- Public Interface --
   ----------------------

   procedure Read_Code
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : out Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Verbatim_Length : out Natural;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
   is
      Ignored : String (1 .. 2);
      Offset_Backup : Ada.Streams.Stream_Element_Offset;
   begin
      Tools.Next_Digit (Input, Offset, Code);

      if Code <= Last_Code then
         Verbatim_Length := 0;

      elsif Variable_Length_Verbatim then
         Verbatim_Length := 64 - Natural (Code);
         Code := 0;

      elsif Code = 63 then
         Tools.Next_Digit (Input, Offset, Code);
         Verbatim_Length := Natural (Code) * 3 + 3;
         Code := 0;

      elsif Code = 62 then
         Offset_Backup := Offset;
         Tools.Decode_Single (Input, Offset, Ignored (1), Code);
         Verbatim_Length := Natural (Code) * 3 + 1;
         Offset := Offset_Backup;
         Code := 0;

      else
         Offset_Backup := Offset;
         Verbatim_Length := (Natural (Code) - 61)
                          * (Natural (Tools.Single_Byte_Padding'Last) + 1);
         Tools.Decode_Double (Input, Offset, Ignored, Code);
         Verbatim_Length := (Verbatim_Length + Natural (Code)) * 3 + 2;
         Offset := Offset_Backup;
         Code := 0;
      end if;
   end Read_Code;

   procedure Read_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String)
   is
      Ignored : Tools.Base_64_Digit;
      Output_Index : Natural := Output'First - 1;
   begin
      if Output'Length mod 3 = 1 then
         Tools.Decode_Single
           (Input, Offset, Output (Output_Index + 1), Ignored);
         Output_Index := Output_Index + 1;
      elsif Output'Length mod 3 = 2 then
         Tools.Decode_Double
           (Input, Offset,
            Output (Output_Index + 1 .. Output_Index + 2), Ignored);
         Output_Index := Output_Index + 2;
      end if;

      if Output_Index < Output'Last then
         Tools.Decode
           (Input, Offset, Output (Output_Index + 1 .. Output'Last));
      end if;
   end Read_Verbatim;

   procedure Skip_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Verbatim_Length : in Positive)
   is
      Code : Tools.Base_64_Digit;
   begin
      for I in 1 .. Tools.Image_Length (Verbatim_Length) loop
         Tools.Next_Digit (Input, Offset, Code);
      end loop;
   end Skip_Verbatim;

   function Verbatim_Size
     (Input_Length : in Positive;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
     return Ada.Streams.Stream_Element_Count is
   begin
      if Variable_Length_Verbatim then
         declare
            Largest_Run : constant Positive := 63 - Natural (Last_Code);
            Run_Count : constant Positive
              := (Input_Length + Largest_Run - 1) / Largest_Run;
            Last_Run_Size : constant Positive
              := Input_Length - (Run_Count - 1) * Largest_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Run_Count - 1)
                    * (Tools.Image_Length (Largest_Run) + 1)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      elsif Input_Length mod 3 = 0 then
         declare
            Largest_Run : constant Positive := 64 * 3;
            Run_Count : constant Positive
              := (Input_Length + Largest_Run - 1) / Largest_Run;
            Last_Run_Size : constant Positive
              := Input_Length - (Run_Count - 1) * Largest_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Run_Count - 1)
                    * (Tools.Image_Length (Largest_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 2;
         end;
      elsif Input_Length mod 3 = 1 then
         declare
            Largest_Final_Run : constant Positive := 15 * 3 + 1;
            Largest_Prefix_Run : constant Positive := 64 * 3;
            Prefix_Run_Count : constant Natural
              := (Input_Length + Largest_Prefix_Run - Largest_Final_Run)
               / Largest_Prefix_Run;
            Last_Run_Size : constant Positive
              := Input_Length - Prefix_Run_Count * Largest_Prefix_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Prefix_Run_Count)
                    * (Tools.Image_Length (Largest_Prefix_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      elsif Input_Length mod 3 = 2 then
         declare
            Largest_Final_Run : constant Positive
              := ((62 - Natural (Last_Code)) * 4 - 1) * 3 + 2;
            Largest_Prefix_Run : constant Positive := 64 * 3;
            Prefix_Run_Count : constant Natural
              := (Input_Length + Largest_Prefix_Run - Largest_Final_Run)
               / Largest_Prefix_Run;
            Last_Run_Size : constant Positive
              := Input_Length - Prefix_Run_Count * Largest_Prefix_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Prefix_Run_Count)
                    * (Tools.Image_Length (Largest_Prefix_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      else
         raise Program_Error with "Condition unreachable";
      end if;
   end Verbatim_Size;

   procedure Write_Code
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit) is
   begin
      Output (Offset) := Tools.Image (Code);
      Offset := Offset + 1;
   end Write_Code;

   procedure Write_Verbatim
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Input : in String;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
   is
      Index : Positive := Input'First;
   begin
      if Variable_Length_Verbatim then
         declare
            Largest_Run : constant Positive := 63 - Natural (Last_Code);
            Length, Last : Positive;
         begin
            while Index in Input'Range loop
               Length := Positive'Min (Largest_Run, Input'Last + 1 - Index);
               Last := Index + Length - 1;
               Output (Offset)
                 := Tools.Image (63 - Tools.Base_64_Digit (Length - 1));
               Offset := Offset + 1;
               Tools.Encode (Input (Index .. Last), Output, Offset);
               Index := Last + 1;
            end loop;
         end;
      else
         if Input'Length mod 3 = 1 then
            declare
               Extra_Blocks : constant Natural
                 := Natural'Min (15, Input'Length / 3);
            begin
               Output (Offset) := Tools.Image (62);
               Offset := Offset + 1;

               Tools.Encode_Single
                 (Input (Index), Tools.Single_Byte_Padding (Extra_Blocks),
                  Output, Offset);
               Index := Index + 1;

               if Extra_Blocks > 0 then
                  Tools.Encode
                    (Input (Index .. Index + Extra_Blocks * 3 - 1),
                     Output, Offset);
                  Index := Index + Extra_Blocks * 3;
               end if;
            end;
         elsif Input'Length mod 3 = 2 then
            declare
               Extra_Blocks : constant Natural := Natural'Min
                 (Input'Length / 3,
                  (62 - Natural (Last_Code)) * 4 - 1);
            begin
               Output (Offset)
                 := Tools.Image (61 - Tools.Base_64_Digit (Extra_Blocks / 4));
               Offset := Offset + 1;

               Tools.Encode_Double
                 (Input (Index .. Index + 1),
                  Tools.Double_Byte_Padding (Extra_Blocks mod 4),
                  Output, Offset);
               Index := Index + 1;

               if Extra_Blocks > 0 then
                  Tools.Encode
                    (Input (Index .. Index + Extra_Blocks * 3 - 1),
                     Output, Offset);
                  Index := Index + Extra_Blocks * 3;
               end if;
            end;
         end if;

         pragma Assert ((Input'Last + 1 - Index) mod 3 = 0);

         while Index <= Input'Last loop
            declare
               Block_Count : constant Natural
                 := Natural'Min (64, (Input'Last + 1 - Index) / 3);
            begin
               Output (Offset) := Tools.Image (63);
               Output (Offset + 1)
                 := Tools.Image (Tools.Base_64_Digit (Block_Count - 1));
               Offset := Offset + 2;

               Tools.Encode
                 (Input (Index .. Index + Block_Count * 3 - 1),
                  Output, Offset);
               Index := Index + Block_Count * 3;
            end;
         end loop;
      end if;
   end Write_Verbatim;

end Natools.Smaz_Implementations.Base_64;

------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.Smaz_Implementations.Base_64 is

   package Tools renames Natools.Smaz_Implementations.Base_64_Tools;

   use type Ada.Streams.Stream_Element_Offset;
   use type Tools.Base_64_Digit;

   ----------------------
   -- Public Interface --
   ----------------------

   procedure Read_Code
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : out Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Verbatim_Length : out Natural;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
   is
      Ignored : String (1 .. 2);
      Offset_Backup : Ada.Streams.Stream_Element_Offset;
   begin
      Tools.Next_Digit (Input, Offset, Code);

      if Code <= Last_Code then
         Verbatim_Length := 0;

      elsif Variable_Length_Verbatim then
         Verbatim_Length := 64 - Natural (Code);
         Code := 0;

      elsif Code = 63 then
         Tools.Next_Digit (Input, Offset, Code);
         Verbatim_Length := Natural (Code) * 3 + 3;
         Code := 0;

      elsif Code = 62 then
         Offset_Backup := Offset;
         Tools.Decode_Single (Input, Offset, Ignored (1), Code);
         Verbatim_Length := Natural (Code) * 3 + 1;
         Offset := Offset_Backup;
         Code := 0;

      else
         Offset_Backup := Offset;
         Verbatim_Length := (61 - Natural (Code)) * 4;
         Tools.Decode_Double (Input, Offset, Ignored, Code);
         Verbatim_Length := (Verbatim_Length + Natural (Code)) * 3 + 2;
         Offset := Offset_Backup;
         Code := 0;
      end if;
   end Read_Code;

   procedure Read_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String)
   is
      Ignored : Tools.Base_64_Digit;
      Output_Index : Natural := Output'First - 1;
   begin
      if Output'Length mod 3 = 1 then
         Tools.Decode_Single
           (Input, Offset, Output (Output_Index + 1), Ignored);
         Output_Index := Output_Index + 1;
      elsif Output'Length mod 3 = 2 then
         Tools.Decode_Double
           (Input, Offset,
            Output (Output_Index + 1 .. Output_Index + 2), Ignored);
         Output_Index := Output_Index + 2;
      end if;

      if Output_Index < Output'Last then
         Tools.Decode
           (Input, Offset, Output (Output_Index + 1 .. Output'Last));
      end if;
   end Read_Verbatim;

   procedure Skip_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Verbatim_Length : in Positive)
   is
      Code : Tools.Base_64_Digit;
   begin
      for I in 1 .. Tools.Image_Length (Verbatim_Length) loop
         Tools.Next_Digit (Input, Offset, Code);
      end loop;
   end Skip_Verbatim;

   function Verbatim_Size
     (Input_Length : in Positive;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
     return Ada.Streams.Stream_Element_Count is
   begin
      if Variable_Length_Verbatim then
         declare
            Largest_Run : constant Positive := 63 - Natural (Last_Code);
            Run_Count : constant Positive
              := (Input_Length + Largest_Run - 1) / Largest_Run;
            Last_Run_Size : constant Positive
              := Input_Length - (Run_Count - 1) * Largest_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Run_Count - 1)
                    * (Tools.Image_Length (Largest_Run) + 1)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      elsif Input_Length mod 3 = 0 then
         declare
            Largest_Run : constant Positive := 64 * 3;
            Run_Count : constant Positive
              := (Input_Length + Largest_Run - 1) / Largest_Run;
            Last_Run_Size : constant Positive
              := Input_Length - (Run_Count - 1) * Largest_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Run_Count - 1)
                    * (Tools.Image_Length (Largest_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 2;
         end;
      elsif Input_Length mod 3 = 1 then
         declare
            Largest_Final_Run : constant Positive := 15 * 3 + 1;
            Largest_Prefix_Run : constant Positive := 64 * 3;
            Prefix_Run_Count : constant Natural
              := (Input_Length + Largest_Prefix_Run - Largest_Final_Run)
               / Largest_Prefix_Run;
            Last_Run_Size : constant Positive
              := Input_Length - Prefix_Run_Count * Largest_Prefix_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Prefix_Run_Count)
                    * (Tools.Image_Length (Largest_Prefix_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      elsif Input_Length mod 3 = 2 then
         declare
            Largest_Final_Run : constant Positive
              := ((62 - Natural (Last_Code)) * 4 - 1) * 3 + 2;
            Largest_Prefix_Run : constant Positive := 64 * 3;
            Prefix_Run_Count : constant Natural
              := (Input_Length + Largest_Prefix_Run - Largest_Final_Run)
               / Largest_Prefix_Run;
            Last_Run_Size : constant Positive
              := Input_Length - Prefix_Run_Count * Largest_Prefix_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Prefix_Run_Count)
                    * (Tools.Image_Length (Largest_Prefix_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      else
         raise Program_Error with "Condition unreachable";
      end if;
   end Verbatim_Size;

   procedure Write_Code
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit) is
   begin
      Output (Offset) := Tools.Image (Code);
      Offset := Offset + 1;
   end Write_Code;

   procedure Write_Verbatim
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Input : in String;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
   is
      Index : Positive := Input'First;
   begin
      if Variable_Length_Verbatim then
         declare
            Largest_Run : constant Positive := 63 - Natural (Last_Code);
            Length, Last : Positive;
         begin
            while Index in Input'Range loop
               Length := Positive'Min (Largest_Run, Input'Last + 1 - Index);
               Last := Index + Length - 1;
               Output (Offset)
                 := Tools.Image (63 - Tools.Base_64_Digit (Length - 1));
               Offset := Offset + 1;
               Tools.Encode (Input (Index .. Last), Output, Offset);
               Index := Last + 1;
            end loop;
         end;
      else
         if Input'Length mod 3 = 1 then
            declare
               Extra_Blocks : constant Natural
                 := Natural'Min (15, Input'Length / 3);
            begin
               Output (Offset) := Tools.Image (62);
               Offset := Offset + 1;

               Tools.Encode_Single
                 (Input (Index), Tools.Single_Byte_Padding (Extra_Blocks),
                  Output, Offset);
               Index := Index + 1;

               if Extra_Blocks > 0 then
                  Tools.Encode
                    (Input (Index .. Index + Extra_Blocks * 3 - 1),
                     Output, Offset);
                  Index := Index + Extra_Blocks * 3;
               end if;
            end;
         elsif Input'Length mod 3 = 2 then
            declare
               Extra_Blocks : constant Natural := Natural'Min
                 (Input'Length / 3,
                  (62 - Natural (Last_Code)) * 4 - 1);
            begin
               Output (Offset)
                 := Tools.Image (61 - Tools.Base_64_Digit (Extra_Blocks / 4));
               Offset := Offset + 1;

               Tools.Encode_Double
                 (Input (Index .. Index + 1),
                  Tools.Double_Byte_Padding (Extra_Blocks mod 4),
                  Output, Offset);
               Index := Index + 1;

               if Extra_Blocks > 0 then
                  Tools.Encode
                    (Input (Index .. Index + Extra_Blocks * 3 - 1),
                     Output, Offset);
                  Index := Index + Extra_Blocks * 3;
               end if;
            end;
         end if;

         pragma Assert ((Input'Last + 1 - Index) mod 3 = 0);

         while Index <= Input'Last loop
            declare
               Block_Count : constant Natural
                 := Natural'Min (64, (Input'Last + 1 - Index) / 3);
            begin
               Output (Offset) := Tools.Image (63);
               Output (Offset + 1)
                 := Tools.Image (Tools.Base_64_Digit (Block_Count - 1));
               Offset := Offset + 2;

               Tools.Encode
                 (Input (Index .. Index + Block_Count * 3 - 1),
                  Output, Offset);
               Index := Index + Block_Count * 3;
            end;
         end loop;
      end if;
   end Write_Verbatim;

end Natools.Smaz_Implementations.Base_64;

fix reading of 3n+2 verbatim length

smaz_implementations-base_64: fix reading of 3n+2 verbatim length

A sign error caused a direct constraint error, and using the wrong type
caused overlong reads (now 4 is hardcoded just like it is in encoding
code).