-----------------------------------------------------------------------
--  security-contexts -- Context to provide security information and verify permissions
--  Copyright (C) 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.Finalization;

with Util.Strings.Maps;
with Security.Permissions;

--  == Security Context ==
--  The security context provides contextual information for a security controller to
--  verify that a permission is granted.
--  This security context is used as follows:
--
--    * An instance of the security context is declared within a function/procedure as
--      a local variable
--
--    * This instance will be associated with the current thread through a task attribute
--
--    * The security context is populated with information to identify the current user,
--      his roles, permissions and other information that could be used by security controllers
--
--    * To verify a permission, the current security context is retrieved and the
--      Has_Permission operation is called,
--
--    * The Has_Permission will first look in a small cache stored in the security context.
--
--    * When not present in the cache, it will use the security manager to find the
--      security controller associated with the permission to verify
--
--    * The security controller will be called with the security context to check the permission.
--      The whole job of checking the permission is done by the security controller.
--      The security controller retrieves information from the security context to decide
--      whether the permission is granted or not.
--
--    * The result produced by the security controller is then saved in the local cache.
--
package Security.Contexts is

   Invalid_Context : exception;

   type Security_Context is new Ada.Finalization.Limited_Controlled with private;
   type Security_Context_Access is access all Security_Context'Class;

   --  Get the application associated with the current service operation.
   function Get_User_Principal (Context : in Security_Context'Class)
                                return Security.Permissions.Principal_Access;
   pragma Inline_Always (Get_User_Principal);

   --  Get the permission manager.
   function Get_Permission_Manager (Context : in Security_Context'Class)
                                    return Security.Permissions.Permission_Manager_Access;
   pragma Inline_Always (Get_Permission_Manager);

   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   procedure Has_Permission (Context    : in out Security_Context;
                             Permission : in Security.Permissions.Permission_Index;
                             Result     : out Boolean);

   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   procedure Has_Permission (Context    : in out Security_Context;
                             Permission : in String;
                             Result     : out Boolean);

   --  Initializes the service context.  By creating the Security_Context variable,
   --  the instance will be associated with the current task attribute.  If the current task
   --  already has a security context, the new security context is installed, the old one
   --  being kept.
   overriding
   procedure Initialize (Context : in out Security_Context);

   --  Finalize the security context releases any object.  The previous security context is
   --  restored to the current task attribute.
   overriding
   procedure Finalize (Context : in out Security_Context);

   --  Set the current application and user context.
   procedure Set_Context (Context   : in out Security_Context;
                          Manager   : in Security.Permissions.Permission_Manager_Access;
                          Principal : in Security.Permissions.Principal_Access);

   --  Add a context information represented by Value under the name identified by
   --  Name in the security context Context.
   procedure Add_Context (Context   : in out Security_Context;
                          Name      : in String;
                          Value     : in String);

   --  Get the context information registered under the name Name in the security
   --  context Context.
   --  Raises Invalid_Context if there is no such information.
   function Get_Context (Context  : in Security_Context;
                         Name     : in String) return String;

   --  Returns True if a context information was registered under the name Name.
   function Has_Context (Context : in Security_Context;
                         Name    : in String) return Boolean;

   --  Get the current security context.
   --  Returns null if the current thread is not associated with any security context.
   function Current return Security_Context_Access;
   pragma Inline_Always (Current);

   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   function Has_Permission (Permission : in Security.Permissions.Permission_Index) return Boolean;

   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   function Has_Permission (Permission : in String) return Boolean;

private

   type Permission_Cache is record
      Perm   : Security.Permissions.Permission_Type;
      Result : Boolean;
   end record;

   type Security_Context is new Ada.Finalization.Limited_Controlled with record
      Previous    : Security_Context_Access := null;
      Manager     : Security.Permissions.Permission_Manager_Access := null;
      Principal   : Security.Permissions.Principal_Access := null;
      Context     : Util.Strings.Maps.Map;
   end record;

end Security.Contexts;

-----------------------------------------------------------------------
--  security-contexts -- Context to provide security information and verify permissions
--  Copyright (C) 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.Finalization;

with Util.Strings.Maps;
with Security.Permissions;

--  == Security Context ==
--  The security context provides contextual information for a security controller to
--  verify that a permission is granted.
--  This security context is used as follows:
--
--    * An instance of the security context is declared within a function/procedure as
--      a local variable
--
--    * This instance will be associated with the current thread through a task attribute
--
--    * The security context is populated with information to identify the current user,
--      his roles, permissions and other information that could be used by security controllers
--
--    * To verify a permission, the current security context is retrieved and the
--      Has_Permission operation is called,
--
--    * The Has_Permission will first look in a small cache stored in the security context.
--
--    * When not present in the cache, it will use the security manager to find the
--      security controller associated with the permission to verify
--
--    * The security controller will be called with the security context to check the permission.
--      The whole job of checking the permission is done by the security controller.
--      The security controller retrieves information from the security context to decide
--      whether the permission is granted or not.
--
--    * The result produced by the security controller is then saved in the local cache.
--
package Security.Contexts is

   Invalid_Context : exception;

   type Security_Context is new Ada.Finalization.Limited_Controlled with private;
   type Security_Context_Access is access all Security_Context'Class;

   --  Get the application associated with the current service operation.
   function Get_User_Principal (Context : in Security_Context'Class)
                                return Security.Principal_Access;
   pragma Inline_Always (Get_User_Principal);

   --  Get the permission manager.
   function Get_Permission_Manager (Context : in Security_Context'Class)
                                    return Security.Permissions.Permission_Manager_Access;
   pragma Inline_Always (Get_Permission_Manager);

   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   procedure Has_Permission (Context    : in out Security_Context;
                             Permission : in Security.Permissions.Permission_Index;
                             Result     : out Boolean);

   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   procedure Has_Permission (Context    : in out Security_Context;
                             Permission : in String;
                             Result     : out Boolean);

   --  Initializes the service context.  By creating the Security_Context variable,
   --  the instance will be associated with the current task attribute.  If the current task
   --  already has a security context, the new security context is installed, the old one
   --  being kept.
   overriding
   procedure Initialize (Context : in out Security_Context);

   --  Finalize the security context releases any object.  The previous security context is
   --  restored to the current task attribute.
   overriding
   procedure Finalize (Context : in out Security_Context);

   --  Set the current application and user context.
   procedure Set_Context (Context   : in out Security_Context;
                          Manager   : in Security.Permissions.Permission_Manager_Access;
                          Principal : in Security.Principal_Access);

   --  Add a context information represented by Value under the name identified by
   --  Name in the security context Context.
   procedure Add_Context (Context   : in out Security_Context;
                          Name      : in String;
                          Value     : in String);

   --  Get the context information registered under the name Name in the security
   --  context Context.
   --  Raises Invalid_Context if there is no such information.
   function Get_Context (Context  : in Security_Context;
                         Name     : in String) return String;

   --  Returns True if a context information was registered under the name Name.
   function Has_Context (Context : in Security_Context;
                         Name    : in String) return Boolean;

   --  Get the current security context.
   --  Returns null if the current thread is not associated with any security context.
   function Current return Security_Context_Access;
   pragma Inline_Always (Current);

   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   function Has_Permission (Permission : in Security.Permissions.Permission_Index) return Boolean;

   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   function Has_Permission (Permission : in String) return Boolean;

private

   type Permission_Cache is record
      Perm   : Security.Permissions.Permission_Type;
      Result : Boolean;
   end record;

   type Security_Context is new Ada.Finalization.Limited_Controlled with record
      Previous    : Security_Context_Access := null;
      Manager     : Security.Permissions.Permission_Manager_Access := null;
      Principal   : Security.Principal_Access := null;
      Context     : Util.Strings.Maps.Map;
   end record;

end Security.Contexts;

Use the Principal defined in the Security package


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

with Interfaces;
with Wiki.Helpers;
with Wiki.Parsers.Html.Entities;
package body Wiki.Parsers.Html is

   --  Parse an HTML attribute
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Wiki.Strings.BString);

   --  Parse a HTML/XML comment to strip it.
   procedure Parse_Comment (P : in out Parser);

   --  Parse a simple DOCTYPE declaration and ignore it.
   procedure Parse_Doctype (P : in out Parser);

   procedure Collect_Attributes (P     : in out Parser);
   function Is_Letter (C : in Wiki.Strings.WChar) return Boolean;
   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Wiki.Strings.BString);

   function Is_Letter (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return C > ' ' and C /= ':' and C /= '>' and C /= ''' and C /= '"'
        and C /= '/' and C /= '=' and C /= '<';
   end Is_Letter;

   --  ------------------------------
   --  Parse an HTML attribute
   --  ------------------------------
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Wiki.Strings.BString) is
      C : Wiki.Strings.WChar;
   begin
      Skip_Spaces (P);
      while not P.Is_Eof loop
         Peek (P, C);
         if not Is_Letter (C) then
            Put_Back (P, C);
            return;
         end if;
         Wiki.Strings.Wide_Wide_Builders.Append (Name, C);
      end loop;
   end Parse_Attribute_Name;

   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Wiki.Strings.BString) is
      C     : Wiki.Strings.WChar;
      Token : Wiki.Strings.WChar;
   begin
--      Value := Wiki.Strings.To_UString ("");
      Peek (P, Token);
      if Wiki.Helpers.Is_Space (Token) then
         return;
      elsif Token = '>' then
         Put_Back (P, Token);
         return;
      elsif Token /= ''' and Token /= '"' then
         Wiki.Strings.Wide_Wide_Builders.Append (Value, Token);
         while not P.Is_Eof loop
            Peek (P, C);
            if C = ''' or C = '"' or C = ' ' or C = '=' or C = '>' or C = '<' or C = '`' then
               Put_Back (P, C);
               return;
            end if;
            Wiki.Strings.Wide_Wide_Builders.Append (Value, C);
         end loop;
      else
         while not P.Is_Eof loop
            Peek (P, C);
            if C = Token then
               return;
            end if;
            Wiki.Strings.Wide_Wide_Builders.Append (Value, C);
         end loop;
      end if;
   end Collect_Attribute_Value;

   --  ------------------------------
   --  Parse a list of HTML attributes up to the first '>'.
   --  attr-name
   --  attr-name=
   --  attr-name=value
   --  attr-name='value'
   --  attr-name="value"
   --  <name name='value' ...>
   --  ------------------------------
   procedure Collect_Attributes (P     : in out Parser) is
      procedure Append_Attribute (Name : in Wiki.Strings.WString);

      C     : Wiki.Strings.WChar;
      Name  : Wiki.Strings.BString (64);
      Value : Wiki.Strings.BString (256);

      procedure Append_Attribute (Name : in Wiki.Strings.WString) is

         procedure Attribute_Value (Value : in Wiki.Strings.WString);

         procedure Attribute_Value (Value : in Wiki.Strings.WString) is
         begin
            Attributes.Append (P.Attributes, Name, Value);
         end Attribute_Value;

         procedure Attribute_Value is
           new Wiki.Strings.Wide_Wide_Builders.Get (Attribute_Value);
         pragma Inline (Attribute_Value);

      begin
         Attribute_Value (Value);
      end Append_Attribute;
      pragma Inline (Append_Attribute);

      procedure Append_Attribute is
        new Wiki.Strings.Wide_Wide_Builders.Get (Append_Attribute);

   begin
      Wiki.Attributes.Clear (P.Attributes);
      while not P.Is_Eof loop
         Parse_Attribute_Name (P, Name);
         Skip_Spaces (P);
         Peek (P, C);
         if C = '>' or C = '<' or C = '/' then
            Put_Back (P, C);
            exit;
         end if;
         if C = '=' then
            Collect_Attribute_Value (P, Value);
            Append_Attribute (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Value);
         elsif Wiki.Strings.Wide_Wide_Builders.Length (Name) > 0 then
            Put_Back (P, C);
            Append_Attribute (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Name);
         end if;
      end loop;

      --  Add any pending attribute.
      if Wiki.Strings.Wide_Wide_Builders.Length (Name) > 0 then
         Append_Attribute (Name);
      end if;
   end Collect_Attributes;

   --  ------------------------------
   --  Parse a HTML/XML comment to strip it.
   --  ------------------------------
   procedure Parse_Comment (P : in out Parser) is
      C     : Wiki.Strings.WChar;
   begin
      Peek (P, C);
      while not P.Is_Eof loop
         Peek (P, C);
         if C = '-' then
            declare
               Count : Natural := 1;
            begin
               Peek (P, C);
               while not P.Is_Eof and C = '-' loop
                  Peek (P, C);
                  Count := Count + 1;
               end loop;
               exit when C = '>' and Count >= 2;
            end;
         end if;
      end loop;
   end Parse_Comment;

   --  ------------------------------
   --  Parse a simple DOCTYPE declaration and ignore it.
   --  ------------------------------
   procedure Parse_Doctype (P : in out Parser) is
      C : Wiki.Strings.WChar;
   begin
      while not P.Is_Eof loop
         Peek (P, C);
         exit when C = '>';
      end loop;
   end Parse_Doctype;

   --  ------------------------------
   --  Parse a HTML element <XXX attributes>
   --  or parse an end of HTML element </XXX>
   --  ------------------------------
   procedure Parse_Element (P : in out Parser) is
      C    : Wiki.Strings.WChar;

      procedure Add_Element (Token : in Wiki.Strings.WString);

      procedure Add_Element (Token : in Wiki.Strings.WString) is
         Tag  : Wiki.Html_Tag;
      begin
         Tag := Wiki.Find_Tag (Token);
         if C = '/' then
            Skip_Spaces (P);
            Peek (P, C);
            if C /= '>' then
               Put_Back (P, C);
            end if;
            Flush_Text (P);
            if Tag = Wiki.UNKNOWN_TAG then
               if Token = "noinclude" then
                  P.Context.Is_Hidden := not P.Context.Is_Included;
               elsif Token = "includeonly" then
                  P.Context.Is_Hidden := P.Context.Is_Included;
               end if;
            else
               End_Element (P, Tag);
            end if;
         else
            Collect_Attributes (P);
            Peek (P, C);
            if C = '/' then
               Peek (P, C);
               if C = '>' then
                  Start_Element (P, Tag, P.Attributes);
                  End_Element (P, Tag);
                  return;
               end if;
            elsif C /= '>' then
               Put_Back (P, C);
            end if;
            if Tag = UNKNOWN_TAG then
               if Token = "noinclude" then
                  P.Context.Is_Hidden := P.Context.Is_Included;
               elsif Token = "includeonly" then
                  P.Context.Is_Hidden := not P.Context.Is_Included;
               end if;
            else
               Start_Element (P, Tag, P.Attributes);
            end if;
         end if;
      end Add_Element;
      pragma Inline (Add_Element);

      procedure Add_Element is
        new Wiki.Strings.Wide_Wide_Builders.Get (Add_Element);
      pragma Inline (Add_Element);

      Name : Wiki.Strings.BString (64);
   begin
      Peek (P, C);
      if C = '!' then
         Peek (P, C);
         if C = '-' then
            Parse_Comment (P);
         else
            Parse_Doctype (P);
         end if;
         return;
      end if;
      if C /= '/' then
         Put_Back (P, C);
      end if;
      Parse_Attribute_Name (P, Name);
      Add_Element (Name);
   end Parse_Element;

   use Interfaces;

   function From_Hex (C : in Character) return Interfaces.Unsigned_8 is
      (if C >= '0' and C <= '9' then Character'Pos (C) - Character'Pos ('0')
      elsif C >= 'A' and C <= 'F' then Character'Pos (C) - Character'Pos ('A') + 10
      elsif C >= 'a' and C <= 'f' then Character'Pos (C) - Character'Pos ('a') + 10
      else raise Constraint_Error);

   function From_Hex (Value : in String) return Wiki.Strings.WChar is
      Result : Interfaces.Unsigned_32 := 0;
   begin
      for C of Value loop
         Result := Interfaces.Shift_Left (Result, 4);
         Result := Result + Interfaces.Unsigned_32 (From_Hex (C));
      end loop;
      return Wiki.Strings.WChar'Val (Result);
   end From_Hex;

   --  ------------------------------
   --  Parse an HTML entity such as   and replace it with the corresponding code.
   --  ------------------------------
   procedure Parse_Entity (P     : in out Parser;
                           Token : in Wiki.Strings.WChar) is
      pragma Unreferenced (Token);

      Name : String (1 .. 10);
      Len  : Natural := 0;
      High : Natural := Wiki.Parsers.Html.Entities.Keywords'Last;
      Low  : Natural := Wiki.Parsers.Html.Entities.Keywords'First;
      Pos  : Natural;
      C    : Wiki.Strings.WChar;
   begin
      while Len < Name'Last loop
         Peek (P, C);
         exit when C = ';' or else P.Is_Eof;
         Len := Len + 1;
         Name (Len) := Wiki.Strings.To_Char (C);
      end loop;
      while Low <= High loop
         Pos := (Low + High) / 2;
         if Wiki.Parsers.Html.Entities.Keywords (Pos).all = Name (1 .. Len) then
            Parse_Text (P, Entities.Mapping (Pos));
            return;
         elsif Entities.Keywords (Pos).all < Name (1 .. Len) then
            Low := Pos + 1;
         else
            High := Pos - 1;
         end if;
      end loop;

      if Len > 0 and then Name (Name'First) = '#' then
         if Name (Name'First + 1) >= '0' and then Name (Name'First + 1) <= '9' then
            begin
               C := Wiki.Strings.WChar'Val (Natural'Value (Name (Name'First + 1 .. Len)));
               Parse_Text (P, C);
               return;

            exception
               when Constraint_Error =>
                  null;
            end;
         elsif Name (Name'First + 1) = 'x' then
            begin
               C := From_Hex (Name (Name'First + 2 .. Len));
               Parse_Text (P, C);
               return;

            exception
               when Constraint_Error =>
                  null;
            end;

         end if;
      end if;

      --  The HTML entity is not recognized: we must treat it as plain wiki text.
      Parse_Text (P, '&');
      for I in 1 .. Len loop
         Parse_Text (P, Wiki.Strings.To_WChar (Name (I)));
      end loop;
      if Len > 0 and then Len < Name'Last and then C = ';' then
         Parse_Text (P, ';');
      end if;
   end Parse_Entity;

end Wiki.Parsers.Html;

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

with Interfaces;
with Wiki.Helpers;
with Wiki.Parsers.Html.Entities;
package body Wiki.Parsers.Html is

   --  Parse an HTML attribute
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Wiki.Strings.BString);

   --  Parse a HTML/XML comment to strip it.
   procedure Parse_Comment (P : in out Parser);

   --  Parse a simple DOCTYPE declaration and ignore it.
   procedure Parse_Doctype (P : in out Parser);

   procedure Collect_Attributes (P     : in out Parser);
   function Is_Letter (C : in Wiki.Strings.WChar) return Boolean;
   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Wiki.Strings.BString);

   function Is_Letter (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return C > ' ' and C /= ':' and C /= '>' and C /= ''' and C /= '"'
        and C /= '/' and C /= '=' and C /= '<';
   end Is_Letter;

   --  ------------------------------
   --  Parse an HTML attribute
   --  ------------------------------
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Wiki.Strings.BString) is
      C : Wiki.Strings.WChar;
   begin
      Skip_Spaces (P);
      while not P.Is_Eof loop
         Peek (P, C);
         if not Is_Letter (C) then
            Put_Back (P, C);
            return;
         end if;
         Wiki.Strings.Wide_Wide_Builders.Append (Name, C);
      end loop;
   end Parse_Attribute_Name;

   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Wiki.Strings.BString) is
      C     : Wiki.Strings.WChar;
      Token : Wiki.Strings.WChar;
   begin
      Peek (P, Token);
      if Wiki.Helpers.Is_Space (Token) then
         return;
      elsif Token = '>' then
         Put_Back (P, Token);
         return;
      elsif Token /= ''' and Token /= '"' then
         Wiki.Strings.Wide_Wide_Builders.Append (Value, Token);
         while not P.Is_Eof loop
            Peek (P, C);
            if C = ''' or C = '"' or C = ' ' or C = '=' or C = '>' or C = '<' or C = '`' then
               Put_Back (P, C);
               return;
            end if;
            Wiki.Strings.Wide_Wide_Builders.Append (Value, C);
         end loop;
      else
         while not P.Is_Eof loop
            Peek (P, C);
            if C = Token then
               return;
            end if;
            Wiki.Strings.Wide_Wide_Builders.Append (Value, C);
         end loop;
      end if;
   end Collect_Attribute_Value;

   --  ------------------------------
   --  Parse a list of HTML attributes up to the first '>'.
   --  attr-name
   --  attr-name=
   --  attr-name=value
   --  attr-name='value'
   --  attr-name="value"
   --  <name name='value' ...>
   --  ------------------------------
   procedure Collect_Attributes (P     : in out Parser) is
      procedure Append_Attribute (Name : in Wiki.Strings.WString);

      C     : Wiki.Strings.WChar;
      Name  : Wiki.Strings.BString (64);
      Value : Wiki.Strings.BString (256);

      procedure Append_Attribute (Name : in Wiki.Strings.WString) is

         procedure Attribute_Value (Value : in Wiki.Strings.WString);

         procedure Attribute_Value (Value : in Wiki.Strings.WString) is
         begin
            Attributes.Append (P.Attributes, Name, Value);
         end Attribute_Value;

         procedure Attribute_Value is
           new Wiki.Strings.Wide_Wide_Builders.Get (Attribute_Value);
         pragma Inline (Attribute_Value);

      begin
         Attribute_Value (Value);
      end Append_Attribute;
      pragma Inline (Append_Attribute);

      procedure Append_Attribute is
        new Wiki.Strings.Wide_Wide_Builders.Get (Append_Attribute);

   begin
      Wiki.Attributes.Clear (P.Attributes);
      while not P.Is_Eof loop
         Parse_Attribute_Name (P, Name);
         Skip_Spaces (P);
         Peek (P, C);
         if C = '>' or C = '<' or C = '/' then
            Put_Back (P, C);
            exit;
         end if;
         if C = '=' then
            Skip_Spaces (P);
            Collect_Attribute_Value (P, Value);
            Append_Attribute (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Value);
         elsif Wiki.Strings.Wide_Wide_Builders.Length (Name) > 0 then
            Put_Back (P, C);
            Append_Attribute (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Name);
         end if;
      end loop;

      --  Add any pending attribute.
      if Wiki.Strings.Wide_Wide_Builders.Length (Name) > 0 then
         Append_Attribute (Name);
      end if;
   end Collect_Attributes;

   --  ------------------------------
   --  Parse a HTML/XML comment to strip it.
   --  ------------------------------
   procedure Parse_Comment (P : in out Parser) is
      C     : Wiki.Strings.WChar;
   begin
      Peek (P, C);
      while not P.Is_Eof loop
         Peek (P, C);
         if C = '-' then
            declare
               Count : Natural := 1;
            begin
               Peek (P, C);
               while not P.Is_Eof and C = '-' loop
                  Peek (P, C);
                  Count := Count + 1;
               end loop;
               exit when C = '>' and Count >= 2;
            end;
         end if;
      end loop;
   end Parse_Comment;

   --  ------------------------------
   --  Parse a simple DOCTYPE declaration and ignore it.
   --  ------------------------------
   procedure Parse_Doctype (P : in out Parser) is
      C : Wiki.Strings.WChar;
   begin
      while not P.Is_Eof loop
         Peek (P, C);
         exit when C = '>';
      end loop;
   end Parse_Doctype;

   --  ------------------------------
   --  Parse a HTML element <XXX attributes>
   --  or parse an end of HTML element </XXX>
   --  ------------------------------
   procedure Parse_Element (P : in out Parser) is
      C    : Wiki.Strings.WChar;

      procedure Add_Element (Token : in Wiki.Strings.WString);

      procedure Add_Element (Token : in Wiki.Strings.WString) is
         Tag  : Wiki.Html_Tag;
      begin
         Tag := Wiki.Find_Tag (Token);
         if C = '/' then
            Skip_Spaces (P);
            Peek (P, C);
            if C /= '>' then
               Put_Back (P, C);
            end if;
            Flush_Text (P);
            if Tag = Wiki.UNKNOWN_TAG then
               if Token = "noinclude" then
                  P.Context.Is_Hidden := not P.Context.Is_Included;
               elsif Token = "includeonly" then
                  P.Context.Is_Hidden := P.Context.Is_Included;
               end if;
            else
               End_Element (P, Tag);
            end if;
         else
            Collect_Attributes (P);
            Peek (P, C);
            if C = '/' then
               Peek (P, C);
               if C = '>' then
                  Start_Element (P, Tag, P.Attributes);
                  End_Element (P, Tag);
                  return;
               end if;
            elsif C /= '>' then
               Put_Back (P, C);
            end if;
            if Tag = UNKNOWN_TAG then
               if Token = "noinclude" then
                  P.Context.Is_Hidden := P.Context.Is_Included;
               elsif Token = "includeonly" then
                  P.Context.Is_Hidden := not P.Context.Is_Included;
               end if;
            else
               Start_Element (P, Tag, P.Attributes);
            end if;
         end if;
      end Add_Element;
      pragma Inline (Add_Element);

      procedure Add_Element is
        new Wiki.Strings.Wide_Wide_Builders.Get (Add_Element);
      pragma Inline (Add_Element);

      Name : Wiki.Strings.BString (64);
   begin
      Peek (P, C);
      if C = '!' then
         Peek (P, C);
         if C = '-' then
            Parse_Comment (P);
         else
            Parse_Doctype (P);
         end if;
         return;
      end if;
      if C /= '/' then
         Put_Back (P, C);
      end if;
      Parse_Attribute_Name (P, Name);
      Add_Element (Name);
   end Parse_Element;

   use Interfaces;

   function From_Hex (C : in Character) return Interfaces.Unsigned_8 is
      (if C >= '0' and C <= '9' then Character'Pos (C) - Character'Pos ('0')
      elsif C >= 'A' and C <= 'F' then Character'Pos (C) - Character'Pos ('A') + 10
      elsif C >= 'a' and C <= 'f' then Character'Pos (C) - Character'Pos ('a') + 10
      else raise Constraint_Error);

   function From_Hex (Value : in String) return Wiki.Strings.WChar is
      Result : Interfaces.Unsigned_32 := 0;
   begin
      for C of Value loop
         Result := Interfaces.Shift_Left (Result, 4);
         Result := Result + Interfaces.Unsigned_32 (From_Hex (C));
      end loop;
      return Wiki.Strings.WChar'Val (Result);
   end From_Hex;

   --  ------------------------------
   --  Parse an HTML entity such as   and replace it with the corresponding code.
   --  ------------------------------
   procedure Parse_Entity (P     : in out Parser;
                           Token : in Wiki.Strings.WChar) is
      pragma Unreferenced (Token);

      Name : String (1 .. 10);
      Len  : Natural := 0;
      High : Natural := Wiki.Parsers.Html.Entities.Keywords'Last;
      Low  : Natural := Wiki.Parsers.Html.Entities.Keywords'First;
      Pos  : Natural;
      C    : Wiki.Strings.WChar;
   begin
      while Len < Name'Last loop
         Peek (P, C);
         exit when C = ';' or else P.Is_Eof;
         Len := Len + 1;
         Name (Len) := Wiki.Strings.To_Char (C);
      end loop;
      while Low <= High loop
         Pos := (Low + High) / 2;
         if Wiki.Parsers.Html.Entities.Keywords (Pos).all = Name (1 .. Len) then
            Parse_Text (P, Entities.Mapping (Pos));
            return;
         elsif Entities.Keywords (Pos).all < Name (1 .. Len) then
            Low := Pos + 1;
         else
            High := Pos - 1;
         end if;
      end loop;

      if Len > 0 and then Name (Name'First) = '#' then
         if Name (Name'First + 1) >= '0' and then Name (Name'First + 1) <= '9' then
            begin
               C := Wiki.Strings.WChar'Val (Natural'Value (Name (Name'First + 1 .. Len)));
               Parse_Text (P, C);
               return;

            exception
               when Constraint_Error =>
                  null;
            end;
         elsif Name (Name'First + 1) = 'x' then
            begin
               C := From_Hex (Name (Name'First + 2 .. Len));
               Parse_Text (P, C);
               return;

            exception
               when Constraint_Error =>
                  null;
            end;

         end if;
      end if;

      --  The HTML entity is not recognized: we must treat it as plain wiki text.
      Parse_Text (P, '&');
      for I in 1 .. Len loop
         Parse_Text (P, Wiki.Strings.To_WChar (Name (I)));
      end loop;
      if Len > 0 and then Len < Name'Last and then C = ';' then
         Parse_Text (P, ';');
      end if;
   end Parse_Entity;

end Wiki.Parsers.Html;

Fix parsing HTML attributes to allow \n after the '='


-----------------------------------------------------------------------
--  gen-artifacts-docs-markdown -- Artifact for GitHub Markdown documentation format
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body Gen.Artifacts.Docs.Markdown is

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".md";
   end Get_Document_Name;

   --  ------------------------------
   --  Start a new document.
   --  ------------------------------
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is
   begin
      Ada.Text_IO.Put_Line (File, "# " & Ada.Strings.Unbounded.To_String (Document.Title));
      Ada.Text_IO.New_Line (File);
   end Start_Document;

   --  ------------------------------
   --  Write a line in the target document formatting the line if necessary.
   --  ------------------------------
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is
   begin
      if Line.Kind = L_LIST then
         Ada.Text_IO.New_Line (File);
         Ada.Text_IO.Put (File, Line.Content);
         Formatter.Need_Newline := True;

      elsif Line.Kind = L_LIST_ITEM then
         Ada.Text_IO.Put (File, Line.Content);
         Formatter.Need_Newline := True;

      elsif Line.Kind = L_START_CODE or Line.Kind = L_END_CODE then
         if Formatter.Need_NewLine then
            Ada.Text_IO.New_Line (File);
            Formatter.Need_Newline := False;
         end if;
         Ada.Text_IO.Put_Line (File, "```");

      else
         if Formatter.Need_Newline then
            Ada.Text_IO.New_Line (File);
            Formatter.Need_Newline := False;
         end if;
         Ada.Text_IO.Put_Line (File, Line.Content);
      end if;
   end Write_Line;

   --  ------------------------------
   --  Finish the document.
   --  ------------------------------
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is
   begin
      Ada.Text_IO.New_Line (File);
      Ada.Text_IO.Put_Line (File, "----");
      Ada.Text_IO.Put_Line (File,
                            "[Generated by Dynamo](https://github.com/stcarrez/dynamo) from *"
                            & Source & "*");
   end Finish_Document;

end Gen.Artifacts.Docs.Markdown;

-----------------------------------------------------------------------
--  gen-artifacts-docs-markdown -- Artifact for GitHub Markdown documentation format
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body Gen.Artifacts.Docs.Markdown is

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".md";
   end Get_Document_Name;

   --  ------------------------------
   --  Start a new document.
   --  ------------------------------
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is
   begin
      Ada.Text_IO.Put_Line (File, "# " & Ada.Strings.Unbounded.To_String (Document.Title));
      Ada.Text_IO.New_Line (File);
   end Start_Document;

   --  ------------------------------
   --  Write a line in the document.
   --  ------------------------------
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in String) is
   begin
      if Formatter.Need_NewLine then
         Ada.Text_IO.New_Line (File);
         Formatter.Need_Newline := False;
      end if;
      Ada.Text_IO.Put_Line (File, Line);
   end Write_Line;

   --  ------------------------------
   --  Write a line in the target document formatting the line if necessary.
   --  ------------------------------
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is
   begin
      case Line.Kind is
         when L_LIST =>
            Ada.Text_IO.New_Line (File);
            Ada.Text_IO.Put (File, Line.Content);
            Formatter.Need_Newline := True;

         when L_LIST_ITEM =>
            Ada.Text_IO.Put (File, Line.Content);
            Formatter.Need_Newline := True;

         when L_START_CODE | L_END_CODE =>
            Formatter.Write_Line (File, "```");

         when L_TEXT =>
            Formatter.Write_Line (File, Line.Content);

         when L_HEADER_1 =>
            Formatter.Write_Line (File, "# " & Line.Content);

         when L_HEADER_2 =>
            Formatter.Write_Line (File, "## " & Line.Content);

         when L_HEADER_3 =>
            Formatter.Write_Line (File, "### " & Line.Content);

         when L_HEADER_4 =>
            Formatter.Write_Line (File, "#### " & Line.Content);

         when others =>
            null;

      end case;
   end Write_Line;

   --  ------------------------------
   --  Finish the document.
   --  ------------------------------
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is
   begin
      Ada.Text_IO.New_Line (File);
      Ada.Text_IO.Put_Line (File, "----");
      Ada.Text_IO.Put_Line (File,
                            "[Generated by Dynamo](https://github.com/stcarrez/dynamo) from *"
                            & Source & "*");
   end Finish_Document;

end Gen.Artifacts.Docs.Markdown;

Implement the Write_Line procedure Emit a header according to the L_HEADER_X types


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

   use Ada.Strings.Unbounded;

   --  The logger
   Logs : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create (Driver_Name);

   --  ------------------------------
   --  Write the command usage.
   --  ------------------------------
   procedure Usage (Command : in out Command_Type;
                    Name    : in String;
                    Context : in out Context_Type) is
      Config  : Config_Type;
   begin
      Command_Type'Class (Command).Setup (Config, Context);
      Config_Parser.Usage (Name, Config);
   end Usage;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   --  ------------------------------
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Command.Driver.Log (Level, Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Compute_Size (Position : in Command_Maps.Cursor);
      procedure Print (Position : in Command_Maps.Cursor);

      Column : Ada.Text_IO.Positive_Count := 1;

      procedure Compute_Size (Position : in Command_Maps.Cursor) is
         Name : constant String := Command_Maps.Key (Position);
      begin
         if Column < Name'Length then
            Column := Name'Length;
         end if;
      end Compute_Size;

      procedure Print (Position : in Command_Maps.Cursor) is
         Cmd  : constant Command_Access := Command_Maps.Element (Position);
         Name : constant String := Command_Maps.Key (Position);
      begin
         Put ("   ");
         Put (Name);
         if Length (Cmd.Description) > 0 then
            Set_Col (Column + 7);
            Put (To_String (Cmd.Description));
         end if;
         New_Line;
      end Print;

   begin
      Logs.Debug ("Execute command {0}", Name);

      if Args.Get_Count = 0 then
         Usage (Command.Driver.all, Args, Context);
         New_Line;
         Put ("Type '");
         Put (Args.Get_Command_Name);
         Put_Line (" help {command}' for help on a specific command.");
         New_Line;
         Put_Line ("Available subcommands:");

         Command.Driver.List.Iterate (Process => Compute_Size'Access);
         Command.Driver.List.Iterate (Process => Print'Access);
      else
         declare
            Cmd_Name   : constant String := Args.Get_Argument (1);
            Target_Cmd : constant Command_Access := Command.Driver.Find_Command (Cmd_Name);
         begin
            if Target_Cmd = null then
               Logs.Error ("Unknown command '{0}'", Cmd_Name);
               raise Not_Found;
            else
               Target_Cmd.Help (Cmd_Name, Context);
            end if;
         end;
      end if;
   end Execute;

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

   --  ------------------------------
   --  Report the command usage.
   --  ------------------------------
   procedure Usage (Driver  : in Driver_Type;
                    Args    : in Argument_List'Class;
                    Context : in out Context_Type;
                    Name    : in String := "") is
   begin
      Put_Line (To_String (Driver.Desc));
      New_Line;
      if Name'Length > 0 then
         declare
            Command : constant Command_Access := Driver.Find_Command (Name);
         begin
            if Command /= null then
               Command.Usage (Name, Context);
            else
               Put ("Invalid command");
            end if;
         end;
      else
         Put ("Usage: ");
         Put (Args.Get_Command_Name);
         Put (" ");
         Put_Line (To_String (Driver.Usage));
      end if;
   end Usage;

   --  ------------------------------
   --  Set the driver description printed in the usage.
   --  ------------------------------
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String) is
   begin
      Driver.Desc := Ada.Strings.Unbounded.To_Unbounded_String (Description);
   end Set_Description;

   --  ------------------------------
   --  Set the driver usage printed in the usage.
   --  ------------------------------
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String) is
   begin
      Driver.Usage := Ada.Strings.Unbounded.To_Unbounded_String (Usage);
   end Set_Usage;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access) is
   begin
      Command.Driver := Driver'Unchecked_Access;
      Driver.List.Include (Name, Command);
   end Add_Command;

   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Command     : in Command_Access) is
   begin
      Command.Description := Ada.Strings.Unbounded.To_Unbounded_String (Description);
      Add_Command (Driver, Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Handler     : in Command_Handler) is
      Command : constant Command_Access
        := new Handler_Command_Type '(Driver      => Driver'Unchecked_Access,
                                      Description => To_Unbounded_String (Description),
                                      Handler     => Handler);
   begin
      Driver.List.Include (Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Find the command having the given name.
   --  Returns null if the command was not found.
   --  ------------------------------
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access is
      Pos : constant Command_Maps.Cursor := Driver.List.Find (Name);
   begin
      if Command_Maps.Has_Element (Pos) then
         return Command_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Command;

   --  ------------------------------
   --  Execute the command registered under the given name.
   --  ------------------------------
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type) is
      procedure Execute (Cmd_Args : in Argument_List'Class);

      Command : constant Command_Access := Driver.Find_Command (Name);

      procedure Execute (Cmd_Args : in Argument_List'Class) is
      begin
         Command.Execute (Name, Cmd_Args, Context);
      end Execute;

   begin
      if Command /= null then
         declare
            Config  : Config_Type;
         begin
            Command.Setup (Config, Context);
            Config_Parser.Execute (Config, Args, Execute'Access);
         end;
      else
         Logs.Error ("Unkown command '{0}'", Name);
         raise Not_Found;
      end if;
   end Execute;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  ------------------------------
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
      pragma Unreferenced (Driver);
   begin
      Logs.Print (Level, "{0}: {1}", Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Handler (Name, Args, Context);
   end Execute;

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

end Util.Commands.Drivers;

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

   use Ada.Strings.Unbounded;

   --  The logger
   Logs : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create (Driver_Name);

   --  ------------------------------
   --  Get the description associated with the command.
   --  ------------------------------
   function Get_Description (Command : in Command_Type) return String is
   begin
      return To_String (Command.Description);
   end Get_Description;

   --  ------------------------------
   --  Get the name used to register the command.
   --  ------------------------------
   function Get_Name (Command : in Command_Type) return String is
   begin
      return To_String (Command.Name);
   end Get_Name;

   --  ------------------------------
   --  Write the command usage.
   --  ------------------------------
   procedure Usage (Command : in out Command_Type;
                    Name    : in String;
                    Context : in out Context_Type) is
      Config  : Config_Type;
   begin
      Command_Type'Class (Command).Setup (Config, Context);
      Config_Parser.Usage (Name, Config);
   end Usage;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   --  ------------------------------
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Command.Driver.Log (Level, Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Compute_Size (Position : in Command_Maps.Cursor);
      procedure Print (Position : in Command_Maps.Cursor);

      Column : Ada.Text_IO.Positive_Count := 1;

      procedure Compute_Size (Position : in Command_Maps.Cursor) is
         Name : constant String := Command_Maps.Key (Position);
      begin
         if Column < Name'Length then
            Column := Name'Length;
         end if;
      end Compute_Size;

      procedure Print (Position : in Command_Maps.Cursor) is
         Cmd  : constant Command_Access := Command_Maps.Element (Position);
         Name : constant String := Command_Maps.Key (Position);
      begin
         Put ("   ");
         Put (Name);
         if Length (Cmd.Description) > 0 then
            Set_Col (Column + 7);
            Put (To_String (Cmd.Description));
         end if;
         New_Line;
      end Print;

   begin
      Logs.Debug ("Execute command {0}", Name);

      if Args.Get_Count = 0 then
         Usage (Command.Driver.all, Args, Context);
         New_Line;
         Put ("Type '");
         Put (Args.Get_Command_Name);
         Put_Line (" help {command}' for help on a specific command.");
         New_Line;
         Put_Line ("Available subcommands:");

         Command.Driver.List.Iterate (Process => Compute_Size'Access);
         Command.Driver.List.Iterate (Process => Print'Access);
      else
         declare
            Cmd_Name   : constant String := Args.Get_Argument (1);
            Target_Cmd : constant Command_Access := Command.Driver.Find_Command (Cmd_Name);
         begin
            if Target_Cmd = null then
               Logs.Error ("Unknown command '{0}'", Cmd_Name);
               raise Not_Found;
            else
               Target_Cmd.Help (Cmd_Name, Context);
            end if;
         end;
      end if;
   end Execute;

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

   --  ------------------------------
   --  Report the command usage.
   --  ------------------------------
   procedure Usage (Driver  : in Driver_Type;
                    Args    : in Argument_List'Class;
                    Context : in out Context_Type;
                    Name    : in String := "") is
   begin
      Put_Line (To_String (Driver.Desc));
      New_Line;
      if Name'Length > 0 then
         declare
            Command : constant Command_Access := Driver.Find_Command (Name);
         begin
            if Command /= null then
               Command.Usage (Name, Context);
            else
               Put ("Invalid command");
            end if;
         end;
      else
         Put ("Usage: ");
         Put (Args.Get_Command_Name);
         Put (" ");
         Put_Line (To_String (Driver.Usage));
      end if;
   end Usage;

   --  ------------------------------
   --  Set the driver description printed in the usage.
   --  ------------------------------
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String) is
   begin
      Driver.Desc := Ada.Strings.Unbounded.To_Unbounded_String (Description);
   end Set_Description;

   --  ------------------------------
   --  Set the driver usage printed in the usage.
   --  ------------------------------
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String) is
   begin
      Driver.Usage := Ada.Strings.Unbounded.To_Unbounded_String (Usage);
   end Set_Usage;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access) is
   begin
      Command.Name := To_Unbounded_String (Name);
      Command.Driver := Driver'Unchecked_Access;
      Driver.List.Include (Name, Command);
   end Add_Command;

   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Command     : in Command_Access) is
   begin
      Command.Name := To_Unbounded_String (Name);
      Command.Description := Ada.Strings.Unbounded.To_Unbounded_String (Description);
      Add_Command (Driver, Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Handler     : in Command_Handler) is
      Command : constant Command_Access
        := new Handler_Command_Type '(Driver      => Driver'Unchecked_Access,
                                      Description => To_Unbounded_String (Description),
                                      Name        => To_Unbounded_String (Name),
                                      Handler     => Handler);
   begin
      Driver.List.Include (Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Find the command having the given name.
   --  Returns null if the command was not found.
   --  ------------------------------
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access is
      Pos : constant Command_Maps.Cursor := Driver.List.Find (Name);
   begin
      if Command_Maps.Has_Element (Pos) then
         return Command_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Command;

   --  ------------------------------
   --  Execute the command registered under the given name.
   --  ------------------------------
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type) is
      procedure Execute (Cmd_Args : in Argument_List'Class);

      Command : constant Command_Access := Driver.Find_Command (Name);

      procedure Execute (Cmd_Args : in Argument_List'Class) is
      begin
         Command.Execute (Name, Cmd_Args, Context);
      end Execute;

   begin
      if Command /= null then
         declare
            Config  : Config_Type;
         begin
            Command.Setup (Config, Context);
            Config_Parser.Execute (Config, Args, Execute'Access);
         end;
      else
         Logs.Error ("Unkown command '{0}'", Name);
         raise Not_Found;
      end if;
   end Execute;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  ------------------------------
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
      pragma Unreferenced (Driver);
   begin
      Logs.Print (Level, "{0}: {1}", Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Handler (Name, Args, Context);
   end Execute;

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

end Util.Commands.Drivers;

Add Get_Name and Get_Description on Command_Type and record the name when we create a command