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

with ASF.Applications;

with ADO;
with AWA.Modules;
with AWA.Blogs.Models;

with Security.Permissions;

--  The Blogs.Module manages the creation, update, removal of blog posts in an application.
--
package AWA.Blogs.Modules is

   NAME : constant String := "blogs";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   Not_Found : exception;

   type Blog_Module is new AWA.Modules.Module with private;
   type Blog_Module_Access is access all Blog_Module'Class;

   --  Initialize the blog module.
   overriding
   procedure Initialize (Plugin : in out Blog_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the blog module instance associated with the current application.
   function Get_Blog_Module return Blog_Module_Access;

   --  Create a new blog for the user workspace.
   procedure Create_Blog (Model        : in Blog_Module;
                          Workspace_Id : in ADO.Identifier;
                          Title        : in String;
                          Result       : out ADO.Identifier);

   --  Create a new post associated with the given blog identifier.
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier);

   --  Update the post title and text associated with the blog post identified by Post.
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Status  : in AWA.Blogs.Models.Post_Status_Type);

   --  Delete the post identified by the given identifier.
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier);

private

   type Blog_Module is new AWA.Modules.Module with null record;

end AWA.Blogs.Modules;

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

with ASF.Applications;

with ADO;
with AWA.Modules;
with AWA.Blogs.Models;

with Security.Permissions;

--  The Blogs.Module manages the creation, update, removal of blog posts in an application.
--
package AWA.Blogs.Modules is

   NAME : constant String := "blogs";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   Not_Found : exception;

   type Blog_Module is new AWA.Modules.Module with private;
   type Blog_Module_Access is access all Blog_Module'Class;

   --  Initialize the blog module.
   overriding
   procedure Initialize (Plugin : in out Blog_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the blog module instance associated with the current application.
   function Get_Blog_Module return Blog_Module_Access;

   --  Create a new blog for the user workspace.
   procedure Create_Blog (Model        : in Blog_Module;
                          Workspace_Id : in ADO.Identifier;
                          Title        : in String;
                          Result       : out ADO.Identifier);

   --  Create a new post associated with the given blog identifier.
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier);

   --  Update the post title and text associated with the blog post identified by Post.
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type);

   --  Delete the post identified by the given identifier.
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier);

private

   type Blog_Module is new AWA.Modules.Module with null record;

end AWA.Blogs.Modules;

Add a parameter to setup the allow comment flag


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

with AWA.Workspaces.Models;
with AWA.Services.Contexts;
with AWA.Storages.Modules;
package body AWA.Images.Beans is

   package ASC renames AWA.Services.Contexts;

   --  ------------------------------
   --  Load the list of images associated with the current folder.
   --  ------------------------------
   overriding
   procedure Load_Files (Storage : in Image_List_Bean) is
      use AWA.Services;

      Ctx       : constant ASC.Service_Context_Access := ASC.Current;
      User      : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session   : ADO.Sessions.Session := Storage.Module.Get_Session;
      Query     : ADO.Queries.Context;
   begin
      if not Storage.Init_Flags (AWA.Storages.Beans.INIT_FOLDER) then
         Load_Folder (Storage);
      end if;
      Query.Set_Query (AWA.Images.Models.Query_Image_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      if Storage.Folder_Bean.Is_Null then
         Query.Bind_Null_Param ("folder_id");
      else
         Query.Bind_Param ("folder_id", Storage.Folder_Bean.Get_Id);
      end if;
      AWA.Images.Models.List (Storage.Image_List_Bean.all, Session, Query);
      Storage.Flags (AWA.Storages.Beans.INIT_FILE_LIST) := True;
   end Load_Files;

   overriding
   function Get_Value (List : in Image_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "images" then
         return Util.Beans.Objects.To_Object (Value   => List.Image_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folders" then
         return Util.Beans.Objects.To_Object (Value   => List.Folder_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folder" then
--           if not List.Init_Flags (INIT_FOLDER) then
--              Load_Folder (List);
--           end if;
         if List.Folder_Bean.Is_Null then
            return Util.Beans.Objects.Null_Object;
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Folder_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Create the Image_List_Bean bean instance.
   --  ------------------------------
   function Create_Image_List_Bean (Module : in AWA.Images.Modules.Image_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      pragma Unreferenced (Module);

      Object    : constant Image_List_Bean_Access := new Image_List_Bean;
   begin
      Object.Module           := AWA.Storages.Modules.Get_Storage_Module;
      Object.Folder_Bean      := Object.Folder'Access;
      Object.Folder_List_Bean := Object.Folder_List'Access;
      Object.Files_List_Bean  := Object.Files_List'Access;
      Object.Image_List_Bean  := Object.Image_List'Access;
      Object.Flags            := Object.Init_Flags'Access;
      return Object.all'Access;
   end Create_Image_List_Bean;

   overriding
   procedure Load (Into    : in out Image_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      use type ADO.Identifier;
      use type Ada.Containers.Count_Type;
      use type Ada.Strings.Unbounded.Unbounded_String;

      Ctx     : constant ASC.Service_Context_Access := ASC.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session : ADO.Sessions.Session := ASC.Get_Session (Ctx);
      Query   : ADO.Queries.Context;
   begin
      if Into.Id = ADO.NO_IDENTIFIER then
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
         return;
      end if;

      --  Get the list of versions associated with the wiki page.
      Query.Set_Query (AWA.Images.Models.Query_Image_Info);
      Query.Bind_Param (Name => "user_id", Value => User);
      Query.Bind_Param (Name => "file_id", Value => Into.Id);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      Into.Load (Session, Query);
   end Load;

   --  Create the Image_Bean bean instance.
   function Create_Image_Bean (Module : in AWA.Images.Modules.Image_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object    : constant Image_Bean_Access := new Image_Bean;
   begin
      Object.Module           := Module;
      return Object.all'Access;
   end Create_Image_Bean;

end AWA.Images.Beans;

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

with AWA.Workspaces.Models;
with AWA.Services.Contexts;
with AWA.Storages.Modules;
package body AWA.Images.Beans is

   package ASC renames AWA.Services.Contexts;

   --  ------------------------------
   --  Load the list of images associated with the current folder.
   --  ------------------------------
   overriding
   procedure Load_Files (Storage : in Image_List_Bean) is
      use AWA.Services;

      Ctx       : constant ASC.Service_Context_Access := ASC.Current;
      User      : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session   : ADO.Sessions.Session := Storage.Module.Get_Session;
      Query     : ADO.Queries.Context;
   begin
      if not Storage.Init_Flags (AWA.Storages.Beans.INIT_FOLDER) then
         Load_Folder (Storage);
      end if;
      Query.Set_Query (AWA.Images.Models.Query_Image_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      if Storage.Folder_Bean.Is_Null then
         Query.Bind_Null_Param ("folder_id");
      else
         Query.Bind_Param ("folder_id", Storage.Folder_Bean.Get_Id);
      end if;
      AWA.Images.Models.List (Storage.Image_List_Bean.all, Session, Query);
      Storage.Flags (AWA.Storages.Beans.INIT_FILE_LIST) := True;
   end Load_Files;

   overriding
   function Get_Value (List : in Image_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "images" then
         return Util.Beans.Objects.To_Object (Value   => List.Image_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folders" then
         return Util.Beans.Objects.To_Object (Value   => List.Folder_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folder" then
--           if not List.Init_Flags (INIT_FOLDER) then
--              Load_Folder (List);
--           end if;
         if List.Folder_Bean.Is_Null then
            return Util.Beans.Objects.Null_Object;
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Folder_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Create the Image_List_Bean bean instance.
   --  ------------------------------
   function Create_Image_List_Bean (Module : in AWA.Images.Modules.Image_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      pragma Unreferenced (Module);

      Object    : constant Image_List_Bean_Access := new Image_List_Bean;
   begin
      Object.Module           := AWA.Storages.Modules.Get_Storage_Module;
      Object.Folder_Bean      := Object.Folder'Access;
      Object.Folder_List_Bean := Object.Folder_List'Access;
      Object.Files_List_Bean  := Object.Files_List'Access;
      Object.Image_List_Bean  := Object.Image_List'Access;
      Object.Flags            := Object.Init_Flags'Access;
      return Object.all'Access;
   end Create_Image_List_Bean;

   overriding
   procedure Load (Into    : in out Image_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      use type ADO.Identifier;

      Ctx     : constant ASC.Service_Context_Access := ASC.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session : ADO.Sessions.Session := ASC.Get_Session (Ctx);
      Query   : ADO.Queries.Context;
   begin
      if Into.Id = ADO.NO_IDENTIFIER then
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
         return;
      end if;

      --  Get the image information.
      Query.Set_Query (AWA.Images.Models.Query_Image_Info);
      Query.Bind_Param (Name => "user_id", Value => User);
      Query.Bind_Param (Name => "file_id", Value => Into.Id);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      Into.Load (Session, Query);

   exception
      when ADO.Objects.NOT_FOUND =>
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");

   end Load;

   --  ------------------------------
   --  Create the Image_Bean bean instance.
   --  ------------------------------
   function Create_Image_Bean (Module : in AWA.Images.Modules.Image_Module_Access)
                               return Util.Beans.Basic.Readonly_Bean_Access is
      Object    : constant Image_Bean_Access := new Image_Bean;
   begin
      Object.Module  := Module;
      Object.Id      := ADO.NO_IDENTIFIER;
      return Object.all'Access;
   end Create_Image_Bean;

end AWA.Images.Beans;

Fix Load operation to handle case where an image is not found or not visible for the user


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

with Util.Commands.Drivers;
with Util.Commands.Consoles;
with Util.Commands.Consoles.Text;
with Druss.Gateways;
package Druss.Commands is

   --  The list of fields that are printed on the console.
   type Field_Type is (F_IP_ADDR,
                       F_COUNT,
                       F_BOOL,
                       F_CHANNEL,
                       F_PROTOCOL,
                       F_ENCRYPTION,
                       F_SSID);

   --  The type of notice that are reported.
   type Notice_Type is (N_HELP,
                        N_INFO);

   --  Make the generic abstract console interface.
   package Consoles is
     new Util.Commands.Consoles (Field_Type  => Field_Type,
                                 Notice_Type => Notice_Type);

   --  And the text console to write on stdout (a Gtk console could be done someday).
   package Text_Consoles is
      new Consoles.Text;

   type Context_Type is limited record
      Gateways : Druss.Gateways.Gateway_Vector;
      Console  : Consoles.Console_Access;
   end record;

   package Drivers is
     new Util.Commands.Drivers (Context_Type => Context_Type,
                                Driver_Name  => "druss-drivers");

   subtype Argument_List is Util.Commands.Argument_List;

   Driver : Drivers.Driver_Type;

   procedure Initialize;

end Druss.Commands;

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

with Util.Commands.Drivers;
with Util.Commands.Consoles;
with Util.Commands.Consoles.Text;
with Druss.Gateways;
package Druss.Commands is

   --  The list of fields that are printed on the console.
   type Field_Type is (F_IP_ADDR,
                       F_COUNT,
                       F_BOOL,
                       F_CHANNEL,
                       F_PROTOCOL,
                       F_ENCRYPTION,
                       F_SSID);

   --  The type of notice that are reported.
   type Notice_Type is (N_HELP,
                        N_INFO);

   --  Make the generic abstract console interface.
   package Consoles is
     new Util.Commands.Consoles (Field_Type  => Field_Type,
                                 Notice_Type => Notice_Type);

   --  And the text console to write on stdout (a Gtk console could be done someday).
   package Text_Consoles is
      new Consoles.Text;

   type Context_Type is limited record
      Gateways : Druss.Gateways.Gateway_Vector;
      Console  : Consoles.Console_Access;
   end record;

   package Drivers is
     new Util.Commands.Drivers (Context_Type => Context_Type,
                                Driver_Name  => "druss-drivers");

   subtype Argument_List is Util.Commands.Argument_List;

   Driver : Drivers.Driver_Type;

   procedure Gateway_Command (Command   : in Drivers.Command_Type'Class;
                              Args      : in Util.Commands.Argument_List'Class;
                              Arg_Pos   : in Positive;
                              Process   : access procedure (Gateway : in out Gateways.Gateway_Type;
                                                            Param   : in String);
                              Context   : in out Context_Type);

   procedure Initialize;

end Druss.Commands;

Declare the Gateway_Command to run a command on one or all gateways based on the arguments


-----------------------------------------------------------------------
--  ADO Databases -- Database Objects
--  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.Strings.Unbounded;
with Ada.Streams;
with Ada.Calendar;

with Util.Refs;
package ADO is

   type Int64 is range -2**63 .. 2**63 - 1;
   for Int64'Size use 64;

   type Unsigned64 is mod 2**64;
   for Unsigned64'Size use 64;

   DEFAULT_TIME : constant Ada.Calendar.Time;

   --  ------------------------------
   --  Database Identifier
   --  ------------------------------
   --
   type Identifier is range -2**47 .. 2**47 - 1;

   NO_IDENTIFIER : constant Identifier := -1;

   type Entity_Type is range 0 .. 2**16 - 1;

   NO_ENTITY_TYPE : constant Entity_Type := 0;

   type Object_Id is record
      Id   : Identifier;
      Kind : Entity_Type;
   end record;
   pragma Pack (Object_Id);

   --  ------------------------------
   --  Nullable Types
   --  ------------------------------
   --  Most database allow to store a NULL instead of an actual integer, date or string value.
   --  Unlike Java, there is no easy way to distinguish between a NULL and an actual valid value.
   --  The Nullable_T types provide a way to specify and check whether a value is null
   --  or not.

   --  An integer which can be null.
   type Nullable_Integer is record
      Value   : Integer := 0;
      Is_Null : Boolean := True;
   end record;

   --  A string which can be null.
   type Nullable_String is record
      Value   : Ada.Strings.Unbounded.Unbounded_String;
      Is_Null : Boolean := True;
   end record;

   --  A date which can be null.
   type Nullable_Time is record
      Value   : Ada.Calendar.Time;
      Is_Null : Boolean := True;
   end record;

   --  ------------------------------
   --  Blob data type
   --  ------------------------------
   --  The Blob type is used to represent database blobs.  The data is stored
   --  in an Ada.Streams.Stream_Element_Array pointed to by the Data member.
   --  The query statement and bind parameter will use a Blob_Ref which represents
   --  a reference to the blob data.  This is intended to minimize data copy.
   type Blob (Len : Ada.Streams.Stream_Element_Offset) is new Util.Refs.Ref_Entity with record
      Data : Ada.Streams.Stream_Element_Array (1 .. Len);
   end record;
   type Blob_Access is access all Blob;

   package Blob_References is new Util.Refs.Indefinite_References (Blob, Blob_Access);
   subtype Blob_Ref is Blob_References.Ref;

   --  Create a blob with an allocated buffer of Size bytes.
   function Create_Blob (Size : in Natural) return Blob_Ref;

   --  Create a blob initialized with the given data buffer.
   function Create_Blob (Data : in Ada.Streams.Stream_Element_Array) return Blob_Ref;

   --  Create a blob initialized with the content from the file whose path is Path.
   --  Raises an IO exception if the file does not exist.
   function Create_Blob (Path : in String) return Blob_Ref;

   --  Return a null blob.
   function Null_Blob return Blob_Ref;

private

   DEFAULT_TIME : constant Ada.Calendar.Time := Ada.Calendar.Time_Of (Year    => 1901,
                                                                      Month   => 1,
                                                                      Day     => 2,
                                                                      Seconds => 0.0);

end ADO;

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

with Ada.Strings.Unbounded;
with Ada.Streams;
with Ada.Calendar;

with Util.Refs;
package ADO is

   type Int64 is range -2**63 .. 2**63 - 1;
   for Int64'Size use 64;

   type Unsigned64 is mod 2**64;
   for Unsigned64'Size use 64;

   DEFAULT_TIME : constant Ada.Calendar.Time;

   --  ------------------------------
   --  Database Identifier
   --  ------------------------------
   --
   type Identifier is range -2**47 .. 2**47 - 1;

   NO_IDENTIFIER : constant Identifier := -1;

   type Entity_Type is range 0 .. 2**16 - 1;

   NO_ENTITY_TYPE : constant Entity_Type := 0;

   type Object_Id is record
      Id   : Identifier;
      Kind : Entity_Type;
   end record;
   pragma Pack (Object_Id);

   --  ------------------------------
   --  Nullable Types
   --  ------------------------------
   --  Most database allow to store a NULL instead of an actual integer, date or string value.
   --  Unlike Java, there is no easy way to distinguish between a NULL and an actual valid value.
   --  The Nullable_T types provide a way to specify and check whether a value is null
   --  or not.

   --  An integer which can be null.
   type Nullable_Integer is record
      Value   : Integer := 0;
      Is_Null : Boolean := True;
   end record;

   --  A string which can be null.
   type Nullable_String is record
      Value   : Ada.Strings.Unbounded.Unbounded_String;
      Is_Null : Boolean := True;
   end record;

   --  A date which can be null.
   type Nullable_Time is record
      Value   : Ada.Calendar.Time;
      Is_Null : Boolean := True;
   end record;

   type Nullable_Entity_Type is record
      Value   : Entity_Type;
      Is_Null : Boolean := True;
   end record;

   --  ------------------------------
   --  Blob data type
   --  ------------------------------
   --  The Blob type is used to represent database blobs.  The data is stored
   --  in an Ada.Streams.Stream_Element_Array pointed to by the Data member.
   --  The query statement and bind parameter will use a Blob_Ref which represents
   --  a reference to the blob data.  This is intended to minimize data copy.
   type Blob (Len : Ada.Streams.Stream_Element_Offset) is new Util.Refs.Ref_Entity with record
      Data : Ada.Streams.Stream_Element_Array (1 .. Len);
   end record;
   type Blob_Access is access all Blob;

   package Blob_References is new Util.Refs.Indefinite_References (Blob, Blob_Access);
   subtype Blob_Ref is Blob_References.Ref;

   --  Create a blob with an allocated buffer of Size bytes.
   function Create_Blob (Size : in Natural) return Blob_Ref;

   --  Create a blob initialized with the given data buffer.
   function Create_Blob (Data : in Ada.Streams.Stream_Element_Array) return Blob_Ref;

   --  Create a blob initialized with the content from the file whose path is Path.
   --  Raises an IO exception if the file does not exist.
   function Create_Blob (Path : in String) return Blob_Ref;

   --  Return a null blob.
   function Null_Blob return Blob_Ref;

private

   DEFAULT_TIME : constant Ada.Calendar.Time := Ada.Calendar.Time_Of (Year    => 1901,
                                                                      Month   => 1,
                                                                      Day     => 2,
                                                                      Seconds => 0.0);

end ADO;

Declare the Nullable_Entity_Type type

Declare the Nullable_Entity_Type type


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

with Ada.Calendar;
with Ada.Calendar.Formatting;
with Ada.Calendar.Arithmetic;
with Ada.Calendar.Time_Zones;

--  = Date Utilities =
--  The `Util.Dates` package provides various date utilities to help in formatting and parsing
--  dates in various standard formats.  It completes the standard `Ada.Calendar.Formatting` and
--  other packages by implementing specific formatting and parsing.
--
--  == Date Operations ==
--  Several operations allow to compute:
--
--    * The start of the day (0:00),
--    * The end of the day (24:00),
--    * The start of the week,
--    * The end of the week,
--    * The start of the month,
--    * The end of the month
--
--  @include util-dates-rfc7231.ads
--  @include util-dates-iso8601.ads
--  @include util-dates-formats.ads
package Util.Dates is

   --  The Unix equivalent of 'struct tm'.
   type Date_Record is record
      Date        : Ada.Calendar.Time;
      Year        : Ada.Calendar.Year_Number;
      Month       : Ada.Calendar.Month_Number;
      Month_Day   : Ada.Calendar.Day_Number;
      Day         : Ada.Calendar.Formatting.Day_Name;
      Hour        : Ada.Calendar.Formatting.Hour_Number;
      Minute      : Ada.Calendar.Formatting.Minute_Number;
      Second      : Ada.Calendar.Formatting.Second_Number;
      Sub_Second  : Ada.Calendar.Formatting.Second_Duration;
      Time_Zone   : Ada.Calendar.Time_Zones.Time_Offset;
      Leap_Second : Boolean;
   end record;

   --  Split the date into a date record (See Ada.Calendar.Formatting.Split).
   procedure Split (Into       : out Date_Record;
                    Date       : in Ada.Calendar.Time;
                    Time_Zone  : in Ada.Calendar.Time_Zones.Time_Offset := 0);

   --  Returns true if the given year is a leap year.
   function Is_Leap_Year (Year : in Ada.Calendar.Year_Number) return Boolean;

   --  Get the number of days in the given year.
   function Get_Day_Count (Year : in Ada.Calendar.Year_Number)
                           return Ada.Calendar.Arithmetic.Day_Count;

   --  Get the number of days in the given month.
   function Get_Day_Count (Year  : in Ada.Calendar.Year_Number;
                           Month : in Ada.Calendar.Month_Number)
                           return Ada.Calendar.Arithmetic.Day_Count;

   --  Get a time representing the given date at 00:00:00.
   function Get_Day_Start (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Day_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  Get a time representing the given date at 23:59:59.
   function Get_Day_End (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Day_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  Get a time representing the beginning of the week at 00:00:00.
   function Get_Week_Start (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Week_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  Get a time representing the end of the week at 23:59:99.
   function Get_Week_End (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Week_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  Get a time representing the beginning of the month at 00:00:00.
   function Get_Month_Start (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Month_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  Get a time representing the end of the month at 23:59:59.
   function Get_Month_End (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Month_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

end Util.Dates;

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

with Ada.Calendar;
with Ada.Calendar.Formatting;
with Ada.Calendar.Arithmetic;
with Ada.Calendar.Time_Zones;

--  = Date Utilities =
--  The `Util.Dates` package provides various date utilities to help in formatting and parsing
--  dates in various standard formats.  It completes the standard `Ada.Calendar.Formatting` and
--  other packages by implementing specific formatting and parsing.
--
--  == Date Operations ==
--  Several operations allow to compute from a given date:
--
--    * `Get_Day_Start`: The start of the day (0:00),
--    * `Get_Day_End`: The end of the day (23:59:59),
--    * `Get_Week_Start`: The start of the week,
--    * `Get_Week_End`: The end of the week,
--    * `Get_Month_Start`: The start of the month,
--    * `Get_Month_End`: The end of the month
--
--  The `Date_Record` type represents a date in a split format allowing
--  to access easily the day, month, hour and other information.
--
--    Now        : Ada.Calendar.Time := Ada.Calendar.Clock;
--    Week_Start : Ada.Calendar.Time := Get_Week_Start (Now);
--    Week_End   : Ada.Calendar.Time := Get_Week_End (Now);
--
--  @include util-dates-rfc7231.ads
--  @include util-dates-iso8601.ads
--  @include util-dates-formats.ads
package Util.Dates is

   --  The Unix equivalent of 'struct tm'.
   type Date_Record is record
      Date        : Ada.Calendar.Time;
      Year        : Ada.Calendar.Year_Number;
      Month       : Ada.Calendar.Month_Number;
      Month_Day   : Ada.Calendar.Day_Number;
      Day         : Ada.Calendar.Formatting.Day_Name;
      Hour        : Ada.Calendar.Formatting.Hour_Number;
      Minute      : Ada.Calendar.Formatting.Minute_Number;
      Second      : Ada.Calendar.Formatting.Second_Number;
      Sub_Second  : Ada.Calendar.Formatting.Second_Duration;
      Time_Zone   : Ada.Calendar.Time_Zones.Time_Offset;
      Leap_Second : Boolean;
   end record;

   --  Split the date into a date record (See Ada.Calendar.Formatting.Split).
   procedure Split (Into       : out Date_Record;
                    Date       : in Ada.Calendar.Time;
                    Time_Zone  : in Ada.Calendar.Time_Zones.Time_Offset := 0);

   --  Returns true if the given year is a leap year.
   function Is_Leap_Year (Year : in Ada.Calendar.Year_Number) return Boolean;

   --  Get the number of days in the given year.
   function Get_Day_Count (Year : in Ada.Calendar.Year_Number)
                           return Ada.Calendar.Arithmetic.Day_Count;

   --  Get the number of days in the given month.
   function Get_Day_Count (Year  : in Ada.Calendar.Year_Number;
                           Month : in Ada.Calendar.Month_Number)
                           return Ada.Calendar.Arithmetic.Day_Count;

   --  Get a time representing the given date at 00:00:00.
   function Get_Day_Start (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Day_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  Get a time representing the given date at 23:59:59.
   function Get_Day_End (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Day_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  Get a time representing the beginning of the week at 00:00:00.
   function Get_Week_Start (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Week_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  Get a time representing the end of the week at 23:59:99.
   function Get_Week_End (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Week_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  Get a time representing the beginning of the month at 00:00:00.
   function Get_Month_Start (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Month_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  Get a time representing the end of the month at 23:59:59.
   function Get_Month_End (Date : in Date_Record) return Ada.Calendar.Time;
   function Get_Month_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time;

end Util.Dates;

Add some documentation

Add some documentation


------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, AdaCore                           --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with System;
with Ada.Unchecked_Conversion;

package STM32.DMA2D is

   type DMA2D_Color is record
      Alpha : Byte;
      Red   : Byte;
      Green : Byte;
      Blue  : Byte;
   end record;

   for DMA2D_Color use record
      Blue  at 0 range 0 .. 7;
      Green at 1 range 0 .. 7;
      Red   at 2 range 0 .. 7;
      Alpha at 3 range 0 .. 7;
   end record;

   Black       : constant DMA2D_Color := (255, 0, 0, 0);
   White       : constant DMA2D_Color := (255, 255, 255, 255);
   Transparent : constant DMA2D_Color := (others => 0);

   --  This bit is set and cleared by software. It cannot be modified
   --  while a transfer is ongoing.
   type DMA2D_MODE is
     (
      --  Memory-to-memory (FG fetch only)
      M2M,

      --  Memory-to-memory with PFC (FG fetch only with FG PFC active)
      M2M_PFC,

      --  Memory-to-memory with blending (FG and BG fetch with PFC and
      --  blending)
      M2M_BLEND,

      --  Register-to-memory (no FG nor BG, only output stage active)
      R2M
     );
   for DMA2D_MODE'Size use 2;

   --  Configuration Error Interrupt Enable
   type DMA2D_FLAG is
     (Disable,
      Enable);

   --  Abort
   --  This bit can be used to abort the current transfer. This bit is
   --  set by software and is automatically reset by hardware when the
   --  START bit is reset.
   type DMA2D_ABORT is
     (
      --  0: No transfer abort requested
      Not_Requested,

      --  1: Transfer abort requested
      Requested);

   --  Suspend
   --  This bit can be used to suspend the current transfer. This bit
   --  is set and reset by software. It is automatically reset by
   --  hardware when the START bit is reset.
   type DMA2D_SUSPEND is
     (
      --  Transfer not suspended
      Not_Suspended,

      --  Transfer suspended
      Supended);

   --  Start
   --  This bit can be used to launch the DMA2D according to the
   --  parameters loaded in the  various configuration registers. This
   --  bit is automatically reset by the following events:
   --  - At the end of the transfer
   --  - When the data transfer is aborted by the user application by
   --    setting the ABORT bit in DMA2D_CR
   --  - When a data transfer error occurs
   --  - When the data transfer has not started due to a configuration
   --    error or another transfer operation already ongoing (automatic
   --    CLUT loading)
   type DMA2D_START is
     (Not_Started,
      Start);

   --  These bits defines the color format
   type DMA2D_Color_Mode is
     (ARGB8888,
      RGB888,
      RGB565,
      ARGB1555,
      ARGB4444,
      L8,
      AL44,
      AL88,
      L4,
      A8,
      A4) with Size => 4;

   subtype DMA2D_CLUT_Color_Mode is DMA2D_Color_Mode range
     ARGB8888 .. RGB888;

   subtype DMA2D_Dst_Color_Mode is DMA2D_Color_Mode range ARGB8888 .. ARGB4444;

   subtype Foreground_Color_Mode is DMA2D_Color_Mode;
   subtype Background_Color_Mode is DMA2D_Color_Mode;
   subtype Output_Color_Mode is DMA2D_Color_Mode range ARGB8888 .. ARGB4444;

--     function Bytes_Per_Pixel (CM : DMA2D_Color_Mode) return Positive
--     is (case CM is
--            when ARGB8888 => 4,
--            when RGB888 => 3,
--            when others => 2);

   --  Alpha mode
   --  00: No modification of the foreground image alpha channel value
   --  01: Replace original foreground image alpha channel value by ALPHA[7:0]
   --  10: Replace original foreground image alpha channel value by ALPHA[7:0]
   --      multiplied with original alpha channel value
   --  other configurations are meaningless
   type DMA2D_AM is
     (NO_MODIF,
      REPLACE,
      MULTIPLY);
   for DMA2D_AM'Size use 2;

   procedure DMA2D_DeInit;

   type DMA2D_Sync_Procedure is access procedure;

   procedure DMA2D_Init
     (Init : DMA2D_Sync_Procedure;
      Wait : DMA2D_Sync_Procedure);

   type DMA2D_Buffer (Color_Mode : DMA2D_Color_Mode := ARGB8888) is record
      Addr       : System.Address;
      Width      : Natural;
      Height     : Natural;
      case Color_Mode is
         when L8 | L4 =>
            CLUT_Color_Mode : DMA2D_CLUT_Color_Mode;
            CLUT_Addr       : System.Address;
         when others =>
            null;
      end case;
   end record;

   Null_Buffer : constant DMA2D_Buffer :=
                   (Addr       => System.Null_Address,
                    Width      => 0,
                    Height     => 0,
                    Color_Mode => DMA2D_Color_Mode'First);

   procedure DMA2D_Fill
     (Buffer      : DMA2D_Buffer;
      Color       : UInt32;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Same as above, using the destination buffer native color representation

   procedure DMA2D_Set_Pixel
     (Buffer      : DMA2D_Buffer;
      X, Y        : Integer;
      Color       : UInt32;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Same as above, using the destination buffer native color representation

   procedure DMA2D_Set_Pixel_Blend
     (Buffer      : DMA2D_Buffer;
      X, Y        : Integer;
      Color       : DMA2D_Color;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;

   procedure DMA2D_Fill_Rect
     (Buffer      : DMA2D_Buffer;
      Color       : UInt32;
      X           : Integer;
      Y           : Integer;
      Width       : Integer;
      Height      : Integer;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Same as above, using the destination buffer native color representation

   procedure DMA2D_Draw_Rect
     (Buffer    : DMA2D_Buffer;
      Color     : UInt32;
      X         : Integer;
      Y         : Integer;
      Width     : Integer;
      Height    : Integer)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Fill the specified area of the buffer with 'Color'

   procedure DMA2D_Copy_Rect
     (Src_Buffer  : DMA2D_Buffer;
      X_Src       : Natural;
      Y_Src       : Natural;
      Dst_Buffer  : DMA2D_Buffer;
      X_Dst       : Natural;
      Y_Dst       : Natural;
      Bg_Buffer   : DMA2D_Buffer;
      X_Bg        : Natural;
      Y_Bg        : Natural;
      Width       : Natural;
      Height      : Natural;
      Synchronous : Boolean := False)
     with Pre => Dst_Buffer.Color_Mode in Output_Color_Mode;
   --  Copy a rectangular area from Src to Dst
   --  If Blend is set, then the rectangle will be merged with the destination
   --  area, taking into account the opacity of the source. Else, it is simply
   --  copied.
   --
   --  if Bg_Buffer is not Null_Buffer, then the copy will be performed in
   --  blend mode: Bg_Buffer and Src_Buffer are combined first and then copied
   --  to Dst_Buffer.

   procedure DMA2D_Draw_Vertical_Line
     (Buffer    : DMA2D_Buffer;
      Color     : UInt32;
      X         : Integer;
      Y         : Integer;
      Height    : Integer;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Draws a vertical line

   procedure DMA2D_Draw_Horizontal_Line
     (Buffer    : DMA2D_Buffer;
      Color     : UInt32;
      X         : Integer;
      Y         : Integer;
      Width     : Integer;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Draws a vertical line

   procedure DMA2D_Wait_Transfer;
   --  Makes sure the DMA2D transfers are done

private

   function As_UInt3 is new Ada.Unchecked_Conversion
     (DMA2D_Dst_Color_Mode, UInt3);
   function As_UInt4 is new Ada.Unchecked_Conversion
     (DMA2D_Color_Mode, UInt4);

end STM32.DMA2D;

------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, AdaCore                           --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with System;
with Ada.Unchecked_Conversion;

package STM32.DMA2D is

   type DMA2D_Color is record
      Alpha : Byte;
      Red   : Byte;
      Green : Byte;
      Blue  : Byte;
   end record;

   for DMA2D_Color use record
      Blue  at 0 range 0 .. 7;
      Green at 1 range 0 .. 7;
      Red   at 2 range 0 .. 7;
      Alpha at 3 range 0 .. 7;
   end record;

   Black       : constant DMA2D_Color := (255, 0, 0, 0);
   White       : constant DMA2D_Color := (255, 255, 255, 255);
   Transparent : constant DMA2D_Color := (others => 0);

   --  This bit is set and cleared by software. It cannot be modified
   --  while a transfer is ongoing.
   type DMA2D_MODE is
     (
      --  Memory-to-memory (FG fetch only)
      M2M,

      --  Memory-to-memory with PFC (FG fetch only with FG PFC active)
      M2M_PFC,

      --  Memory-to-memory with blending (FG and BG fetch with PFC and
      --  blending)
      M2M_BLEND,

      --  Register-to-memory (no FG nor BG, only output stage active)
      R2M
     );
   for DMA2D_MODE'Size use 2;

   --  Configuration Error Interrupt Enable
   type DMA2D_FLAG is
     (Disable,
      Enable);

   --  Abort
   --  This bit can be used to abort the current transfer. This bit is
   --  set by software and is automatically reset by hardware when the
   --  START bit is reset.
   type DMA2D_ABORT is
     (
      --  0: No transfer abort requested
      Not_Requested,

      --  1: Transfer abort requested
      Requested);

   --  Suspend
   --  This bit can be used to suspend the current transfer. This bit
   --  is set and reset by software. It is automatically reset by
   --  hardware when the START bit is reset.
   type DMA2D_SUSPEND is
     (
      --  Transfer not suspended
      Not_Suspended,

      --  Transfer suspended
      Supended);

   --  Start
   --  This bit can be used to launch the DMA2D according to the
   --  parameters loaded in the  various configuration registers. This
   --  bit is automatically reset by the following events:
   --  - At the end of the transfer
   --  - When the data transfer is aborted by the user application by
   --    setting the ABORT bit in DMA2D_CR
   --  - When a data transfer error occurs
   --  - When the data transfer has not started due to a configuration
   --    error or another transfer operation already ongoing (automatic
   --    CLUT loading)
   type DMA2D_START is
     (Not_Started,
      Start);

   --  These bits defines the color format
   type DMA2D_Color_Mode is
     (ARGB8888,
      RGB888,
      RGB565,
      ARGB1555,
      ARGB4444,
      L8,
      AL44,
      AL88,
      L4,
      A8,
      A4) with Size => 4;

   subtype DMA2D_CLUT_Color_Mode is DMA2D_Color_Mode range
     ARGB8888 .. RGB888;

   subtype DMA2D_Dst_Color_Mode is DMA2D_Color_Mode range ARGB8888 .. ARGB4444;

   subtype Foreground_Color_Mode is DMA2D_Color_Mode;
   subtype Background_Color_Mode is DMA2D_Color_Mode;
   subtype Output_Color_Mode is DMA2D_Color_Mode range ARGB8888 .. ARGB4444;

--     function Bytes_Per_Pixel (CM : DMA2D_Color_Mode) return Positive
--     is (case CM is
--            when ARGB8888 => 4,
--            when RGB888 => 3,
--            when others => 2);

   --  Alpha mode
   --  00: No modification of the foreground image alpha channel value
   --  01: Replace original foreground image alpha channel value by ALPHA[7:0]
   --  10: Replace original foreground image alpha channel value by ALPHA[7:0]
   --      multiplied with original alpha channel value
   --  other configurations are meaningless
   type DMA2D_AM is
     (NO_MODIF,
      REPLACE,
      MULTIPLY);
   for DMA2D_AM'Size use 2;

   procedure DMA2D_DeInit;

   type DMA2D_Sync_Procedure is access procedure;

   procedure DMA2D_Init
     (Init : DMA2D_Sync_Procedure;
      Wait : DMA2D_Sync_Procedure);

   type DMA2D_Buffer (Color_Mode : DMA2D_Color_Mode := ARGB8888) is record
      Addr       : System.Address;
      Width      : Natural;
      Height     : Natural;
      case Color_Mode is
         when L8 | L4 =>
            CLUT_Color_Mode : DMA2D_CLUT_Color_Mode;
            CLUT_Addr       : System.Address;
         when others =>
            null;
      end case;
   end record;

   Null_Buffer : constant DMA2D_Buffer :=
                   (Addr       => System.Null_Address,
                    Width      => 0,
                    Height     => 0,
                    Color_Mode => DMA2D_Color_Mode'First);

   procedure DMA2D_Fill
     (Buffer      : DMA2D_Buffer;
      Color       : UInt32;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Same as above, using the destination buffer native color representation

   procedure DMA2D_Set_Pixel
     (Buffer      : DMA2D_Buffer;
      X, Y        : Integer;
      Color       : UInt32;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Same as above, using the destination buffer native color representation

   procedure DMA2D_Set_Pixel_Blend
     (Buffer      : DMA2D_Buffer;
      X, Y        : Integer;
      Color       : DMA2D_Color;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;

   procedure DMA2D_Fill_Rect
     (Buffer      : DMA2D_Buffer;
      Color       : UInt32;
      X           : Integer;
      Y           : Integer;
      Width       : Integer;
      Height      : Integer;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Same as above, using the destination buffer native color representation

   procedure DMA2D_Draw_Rect
     (Buffer    : DMA2D_Buffer;
      Color     : UInt32;
      X         : Integer;
      Y         : Integer;
      Width     : Integer;
      Height    : Integer)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Fill the specified area of the buffer with 'Color'

   procedure DMA2D_Copy_Rect
     (Src_Buffer  : DMA2D_Buffer;
      X_Src       : Natural;
      Y_Src       : Natural;
      Dst_Buffer  : DMA2D_Buffer;
      X_Dst       : Natural;
      Y_Dst       : Natural;
      Bg_Buffer   : DMA2D_Buffer;
      X_Bg        : Natural;
      Y_Bg        : Natural;
      Width       : Natural;
      Height      : Natural;
      Synchronous : Boolean := False)
     with Pre => Dst_Buffer.Color_Mode in Output_Color_Mode;
   --  Copy a rectangular area from Src to Dst
   --  If Blend is set, then the rectangle will be merged with the destination
   --  area, taking into account the opacity of the source. Else, it is simply
   --  copied.
   --
   --  if Bg_Buffer is not Null_Buffer, then the copy will be performed in
   --  blend mode: Bg_Buffer and Src_Buffer are combined first and then copied
   --  to Dst_Buffer.

   procedure DMA2D_Draw_Vertical_Line
     (Buffer    : DMA2D_Buffer;
      Color     : UInt32;
      X         : Integer;
      Y         : Integer;
      Height    : Integer;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Draws a vertical line

   procedure DMA2D_Draw_Horizontal_Line
     (Buffer    : DMA2D_Buffer;
      Color     : UInt32;
      X         : Integer;
      Y         : Integer;
      Width     : Integer;
      Synchronous : Boolean := False)
     with Pre => Buffer.Color_Mode in Output_Color_Mode;
   --  Draws a vertical line

   procedure DMA2D_Wait_Transfer
     with Inline_Always;
   --  Makes sure the DMA2D transfers are done

private

   function As_UInt3 is new Ada.Unchecked_Conversion
     (DMA2D_Dst_Color_Mode, UInt3);
   function As_UInt4 is new Ada.Unchecked_Conversion
     (DMA2D_Color_Mode, UInt4);

end STM32.DMA2D;

Minor: make sure DMA2D_Wait_Transfer is always inline.


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

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

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

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

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

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

      procedure Release (List : in Node_List_Block_Access);

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

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

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

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

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

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

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

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

end Wiki.Nodes;

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

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

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

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

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

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

      procedure Release (List : in Node_List_Block_Access);

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

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

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

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

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

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

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

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

end Wiki.Nodes;

Fix finalization of Node_List

Fix finalization of Node_List


-----------------------------------------------------------------------
--  awa-commands-drivers -- Driver for AWA commands for server or admin tool
--  Copyright (C) 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Command_Line;
with Servlet.Core;
package body AWA.Commands.Drivers is

   use Ada.Strings.Unbounded;

   function "-" (Message : in String) return String is (Message);

   Help_Command            : aliased AWA.Commands.Drivers.Help_Command_Type;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Set_Usage (Config => Config,
                    Usage  => Command.Get_Name & " [arguments]",
                    Help   => Command.Get_Description);
      AWA.Commands.Setup (Config, Context);
   end Setup;

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

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Application_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Define_Switch (Config => Config,
                        Output => Command.Application_Name'Access,
                        Switch => "-a:",
                        Long_Switch => "--application=",
                        Argument => "NAME",
                        Help   => -("Defines the name or URI of the application"));
      AWA.Commands.Setup (Config, Context);
   end Setup;

   function Is_Application (Command : in Application_Command_Type;
                            URI     : in String) return Boolean is
   begin
      return Command.Application_Name.all = URI;
   end Is_Application;

   overriding
   procedure Execute (Command   : in out Application_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Find (URI         : in String;
                      Application : in Servlet.Core.Servlet_Registry_Access);

      Count    : Natural := 0;
      Selected : AWA.Applications.Application_Access;
      App_Name : Unbounded_String;

      procedure Find (URI         : in String;
                      Application : in Servlet.Core.Servlet_Registry_Access) is
      begin
         if Application.all in AWA.Applications.Application'Class then
            if Command.Is_Application (URI) then
               App_Name := To_Unbounded_String (URI (URI'First + 1 .. URI'Last));
               Selected := AWA.Applications.Application'Class (Application.all)'Unchecked_Access;
               Count := Count + 1;
            elsif Command.Application_Name'Length = 0 then
               App_Name := To_Unbounded_String (URI (URI'First + 1 .. URI'Last));
               Selected := AWA.Applications.Application'Class (Application.all)'Unchecked_Access;
               Count := Count + 1;
            end if;
         end if;
      end Find;

   begin
      WS.Iterate (Find'Access);
      if Count /= 1 then
         Context.Console.Notice (N_ERROR, -("No application found"));
         return;
      end if;

      Configure (Selected.all, To_String (App_Name), Context);
      Application_Command_Type'Class (Command).Execute (Selected.all, Args, Context);
   end Execute;

   --  ------------------------------
   --  Print the command usage.
   --  ------------------------------
   procedure Usage (Args    : in Argument_List'Class;
                    Context : in out Context_Type;
                    Name    : in String := "") is
   begin
      GC.Display_Help (Context.Command_Config);
      if Name'Length > 0 then
         Driver.Usage (Args, Context, Name);
      end if;
      Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
   end Usage;

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

   procedure Run (Context   : in out Context_Type;
                  Arguments : out Util.Commands.Dynamic_Argument_List) is
   begin
      GC.Getopt (Config => Context.Command_Config);
      Util.Commands.Parsers.GNAT_Parser.Get_Arguments (Arguments, GC.Get_Argument);

      --if Context.Debug or Context.Verbose or Context.Dump then
      --   AKT.Configure_Logs (Debug   => Context.Debug,
      --                       Dump    => Context.Dump,
      --                       Verbose => Context.Verbose);
      --end if;

      Context.Load_Configuration;

      declare
         Cmd_Name : constant String := Arguments.Get_Command_Name;
      begin
         if Cmd_Name'Length = 0 then
            Context.Console.Notice (N_ERROR, -("Missing command name to execute."));
            Usage (Arguments, Context);
            Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
            return;
         end if;
         Execute (Cmd_Name, Arguments, Context);

      exception
         when GNAT.Command_Line.Invalid_Parameter =>
            Context.Console.Notice (N_ERROR, -("Missing option parameter"));
            raise Error;
      end;

   end Run;

begin
   Driver.Add_Command ("help",
                       -("print some help"),
                       Help_Command'Access);
end AWA.Commands.Drivers;

-----------------------------------------------------------------------
--  awa-commands-drivers -- Driver for AWA commands for server or admin tool
--  Copyright (C) 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Command_Line;
with Servlet.Core;
package body AWA.Commands.Drivers is

   use Ada.Strings.Unbounded;
   use AWA.Applications;

   function "-" (Message : in String) return String is (Message);

   Help_Command            : aliased AWA.Commands.Drivers.Help_Command_Type;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Set_Usage (Config => Config,
                    Usage  => Command.Get_Name & " [arguments]",
                    Help   => Command.Get_Description);
      AWA.Commands.Setup_Command (Config, Context);
   end Setup;

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

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Application_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Define_Switch (Config => Config,
                        Output => Command.Application_Name'Access,
                        Switch => "-a:",
                        Long_Switch => "--application=",
                        Argument => "NAME",
                        Help   => -("Defines the name or URI of the application"));
      AWA.Commands.Setup_Command (Config, Context);
   end Setup;

   function Is_Application (Command : in Application_Command_Type;
                            URI     : in String) return Boolean is
   begin
      return Command.Application_Name.all = URI;
   end Is_Application;

   overriding
   procedure Execute (Command   : in out Application_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Find (URI : in String;
                      App : in Servlet.Core.Servlet_Registry_Access);

      Count    : Natural := 0;
      Selected : Application_Access;
      App_Name : Unbounded_String;

      procedure Find (URI : in String;
                      App : in Servlet.Core.Servlet_Registry_Access) is
      begin
         if Application.all in Application'Class then
            if Command.Is_Application (URI) then
               App_Name := To_Unbounded_String (URI (URI'First + 1 .. URI'Last));
               Selected := Application'Class (Application.all)'Unchecked_Access;
               Count := Count + 1;
            elsif Command.Application_Name'Length = 0 then
               App_Name := To_Unbounded_String (URI (URI'First + 1 .. URI'Last));
               Selected := Application'Class (Application.all)'Unchecked_Access;
               Count := Count + 1;
            end if;
         end if;
      end Find;

   begin
      WS.Iterate (Find'Access);
      if Count /= 1 then
         Context.Console.Notice (N_ERROR, -("No application found"));
         return;
      end if;

      Configure (Selected.all, To_String (App_Name), Context);
      Application_Command_Type'Class (Command).Execute (Selected.all, Args, Context);
   end Execute;

   --  ------------------------------
   --  Print the command usage.
   --  ------------------------------
   procedure Usage (Args    : in Argument_List'Class;
                    Context : in out Context_Type;
                    Name    : in String := "") is
   begin
      GC.Display_Help (Context.Command_Config);
      if Name'Length > 0 then
         Driver.Usage (Args, Context, Name);
      end if;
      Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
   end Usage;

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

   procedure Run (Context   : in out Context_Type;
                  Arguments : out Util.Commands.Dynamic_Argument_List) is
   begin
      GC.Getopt (Config => Context.Command_Config);
      Util.Commands.Parsers.GNAT_Parser.Get_Arguments (Arguments, GC.Get_Argument);

      --if Context.Debug or Context.Verbose or Context.Dump then
      --   AKT.Configure_Logs (Debug   => Context.Debug,
      --                       Dump    => Context.Dump,
      --                       Verbose => Context.Verbose);
      --end if;

      Context.Load_Configuration;

      declare
         Cmd_Name : constant String := Arguments.Get_Command_Name;
      begin
         if Cmd_Name'Length = 0 then
            Context.Console.Notice (N_ERROR, -("Missing command name to execute."));
            Usage (Arguments, Context);
            Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
            return;
         end if;
         Execute (Cmd_Name, Arguments, Context);

      exception
         when GNAT.Command_Line.Invalid_Parameter =>
            Context.Console.Notice (N_ERROR, -("Missing option parameter"));
            raise Error;
      end;

   end Run;

begin
   Driver.Add_Command ("help",
                       -("print some help"),
                       Help_Command'Access);
end AWA.Commands.Drivers;

Rename procedure Setup into Setup_Command because it generates conflict bug in GNAT 2019