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

with CommonText;

package Spatial_Data is

   package CT renames CommonText;

   type Collection_Type is (unset,
                            single_point,
                            single_line_string,
                            single_polygon,
                            multi_point,
                            multi_line_string,
                            multi_polygon,
                            heterogeneous);

   type Geometric_Shape is (point_shape,
                            line_string_shape,
                            polygon_shape,
                            mixture);

   --  The range limits are necessary to avoid storage error warnings
   subtype Geo_Points is Positive range 1 .. 2 ** 20;
   subtype Geo_Units  is Natural  range 0 .. 2 ** 12;

   --  Mutable variant records must be limited if tagged
   --  However, limited geometry cannot work.  We must be able to change the
   --  contents discriminate, so it meants this record cannot be tagged.
   type Geometry (contents : Collection_Type := unset;
                  units    : Geo_Units       := Geo_Units'First;
                  subunits : Geo_Units       := Geo_Units'First;
                  points   : Geo_Points      := Geo_Points'First) is private;

   type Geometric_Real is digits 18;

   type Geometric_Point is
      record
         X : Geometric_Real;
         Y : Geometric_Real;
      end record;

   type Geometric_Circle is
      record
         center_point : Geometric_Point;
         radius       : Geometric_Real;
      end record;

   type Slope_Intercept is
      record
         slope       : Geometric_Real;
         y_intercept : Geometric_Real;
         vertical    : Boolean;
      end record;

   type Standard_Form is
      record
         A : Geometric_Real;
         B : Geometric_Real;
         C : Geometric_Real;
      end record;

   type Geometric_Point_set is array (Positive range <>) of Geometric_Point;
   subtype Geometric_Ring        is Geometric_Point_set;
   subtype Geometric_Line_String is Geometric_Point_set;
   subtype Geometric_Line        is Geometric_Line_String (1 .. 2);
   type Geometric_Polygon (rings  : Geo_Units := Geo_Units'First;
                           points : Geo_Points := Geo_Points'First) is private;

   Origin_Point   : constant Geometric_Point := (0.0, 0.0);

   --------------------------------
   --  Initialization functions  --
   --------------------------------
   function start_polygon               (outer_ring : Geometric_Ring)
                                         return Geometric_Polygon;
   procedure append_inner_ring          (polygon    : in out Geometric_Polygon;
                                         inner_ring : Geometric_Ring);

   function initialize_as_point         (point : Geometric_Point)
                                         return Geometry;
   function initialize_as_multi_point   (point : Geometric_Point)
                                         return Geometry;

   function initialize_as_line          (line_string : Geometric_Line_String)
                                         return Geometry;
   function initialize_as_multi_line    (line_string : Geometric_Line_String)
                                         return Geometry;

   function initialize_as_polygon       (polygon : Geometric_Polygon)
                                         return Geometry;
   function initialize_as_multi_polygon (polygon : Geometric_Polygon)
                                         return Geometry;

   function initialize_as_collection    (anything : Geometry) return Geometry;

   -----------------------------------
   --  Build collections functions  --
   -----------------------------------
   procedure augment_multi_point   (collection : in out Geometry;
                                    point      : Geometric_Point);

   procedure augment_multi_line    (collection : in out Geometry;
                                    line       : Geometric_Line_String);

   procedure augment_multi_polygon (collection : in out Geometry;
                                    polygon    : Geometric_Polygon);

   procedure augment_collection    (collection : in out Geometry;
                                    anything   : Geometry);

   ---------------------------
   --  Retrieval functions  --
   ---------------------------
   function type_of_collection     (collection : Geometry)
                                    return Collection_Type;
   function size_of_collection     (collection : Geometry)
                                    return Positive;
   function collection_item_shape  (collection : Geometry;
                                    index      : Positive := 1)
                                    return Geometric_Shape;
   function collection_item_type   (collection : Geometry;
                                    index      : Positive := 1)
                                    return Collection_Type;

   function retrieve_subcollection (collection : Geometry;
                                    index : Positive := 1)
                                    return Geometry;

   function retrieve_point         (collection : Geometry;
                                    index : Positive := 1)
                                    return Geometric_Point;
   function retrieve_line          (collection : Geometry;
                                    index : Positive := 1)
                                    return Geometric_Line_String;

   function retrieve_polygon       (collection : Geometry;
                                    index      : Positive := 1)
                                    return Geometric_Polygon;
   function number_of_rings        (polygon : Geometric_Polygon)
                                    return Natural;
   function retrieve_ring          (polygon : Geometric_Polygon;
                                    ring_index : Positive)
                                    return Geometric_Ring;

   -------------------
   --  Conversions  --
   -------------------

   function convert_infinite_line (line : Geometric_Line)
                                   return Slope_Intercept;

   function convert_infinite_line (line : Geometric_Line) return Standard_Form;

   function convert_to_infinite_line (std_form : Standard_Form)
                                      return Geometric_Line;

   function convert_to_infinite_line (intercept_form : Slope_Intercept)
                                      return Geometric_Line;

   ---------------------------
   --  Text Representation  --
   ---------------------------
   function mysql_text      (collection : Geometry;
                             top_first  : Boolean := True) return String;
   function Well_Known_Text (collection : Geometry;
                             top_first  : Boolean := True) return String;
   function dump            (collection : Geometry) return String;

   CONVERSION_FAILED       : exception;
   OUT_OF_COLLECTION_RANGE : exception;
   LACKING_POINTS          : exception;
   ILLEGAL_POLY_HOLE       : exception;
   ILLEGAL_SHAPE           : exception;

private

   subtype Geometric_Point_Collection is Geometric_Point_set;
   subtype Item_ID_type is Positive range 1 .. 2 ** 10;  -- 1024 shapes
   type collection_flags is mod 2 ** 24;

   type Ring_Structure is
      record
         Item_Type   : Collection_Type;
         Item_ID     : Item_ID_type;
         Ring_ID     : Geo_Units;
         Ring_Size   : Geo_Points;
         Ring_Count  : Geo_Units;
         Point_Index : Geo_Points;
         Level_Flags : collection_flags;
         Group_ID    : Item_ID_type;
      end record;

   type Ring_Structures is array (Positive range <>) of Ring_Structure;

   type Geometric_Polygon (rings  : Geo_Units := Geo_Units'First;
                           points : Geo_Points := Geo_Points'First) is
      record
         structures : Ring_Structures (1 .. rings);
         points_set : Geometric_Point_Collection (1 .. points) :=
                      (others => Origin_Point);
      end record;

   type Geometry (contents : Collection_Type := unset;
                  units    : Geo_Units := Geo_Units'First;
                  subunits : Geo_Units := Geo_Units'First;
                  points   : Geo_Points := Geo_Points'First) is
      record
         case contents is
            when unset => null;
            when others =>
               structures : Ring_Structures (1 .. subunits);
               points_set : Geometric_Point_Collection (1 .. points);
         end case;
      end record;

   --  returns a trimmed floating point image
   function format_real (value : Geometric_Real) return String;

   --  returns the highest value for Level Flags found
   function highest_level (collection : Geometry) return collection_flags;

   --  raises exception if index is out of range
   procedure check_collection_index (collection : Geometry; index : Positive);

   function single_canvas (gm_type  : Collection_Type;
                           items    : Item_ID_type;
                           subunits : Geo_Units;
                           points   : Geo_Points) return Geometry;

end Spatial_Data;

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

with CommonText;

package Spatial_Data is

   package CT renames CommonText;

   type Collection_Type is (unset,
                            single_point,
                            single_line_string,
                            single_polygon,
                            multi_point,
                            multi_line_string,
                            multi_polygon,
                            heterogeneous);

   type Geometric_Shape is (point_shape,
                            line_string_shape,
                            polygon_shape,
                            mixture);

   --  The range limits are necessary to avoid storage error warnings
   subtype Geo_Points is Positive range 1 .. 2 ** 20;
   subtype Geo_Units  is Natural  range 0 .. 2 ** 12;

   --  Mutable variant records must be limited if tagged
   --  However, limited geometry cannot work.  We must be able to change the
   --  contents discriminate, so it meants this record cannot be tagged.
   type Geometry (contents : Collection_Type := unset;
                  units    : Geo_Units       := Geo_Units'First;
                  subunits : Geo_Units       := Geo_Units'First;
                  points   : Geo_Points      := Geo_Points'First) is private;

   type Geometric_Real is digits 18;

   type Geometric_Point is
      record
         X : Geometric_Real;
         Y : Geometric_Real;
      end record;

   type Geometric_Circle is
      record
         center_point : Geometric_Point;
         radius       : Geometric_Real;
      end record;

   type Slope_Intercept is
      record
         slope       : Geometric_Real;
         y_intercept : Geometric_Real;
         vertical    : Boolean;
      end record;

   type Standard_Form is
      record
         A : Geometric_Real;
         B : Geometric_Real;
         C : Geometric_Real;
      end record;

   type Geometric_Point_set is array (Positive range <>) of Geometric_Point;
   subtype Geometric_Ring        is Geometric_Point_set;
   subtype Geometric_Line_String is Geometric_Point_set;
   subtype Geometric_Line        is Geometric_Line_String (1 .. 2);
   type Geometric_Polygon (rings  : Geo_Units := Geo_Units'First;
                           points : Geo_Points := Geo_Points'First) is private;

   Origin_Point   : constant Geometric_Point := (0.0, 0.0);

   --------------------------------
   --  Initialization functions  --
   --------------------------------
   function start_polygon               (outer_ring : Geometric_Ring)
                                         return Geometric_Polygon;
   procedure append_inner_ring          (polygon    : in out Geometric_Polygon;
                                         inner_ring : Geometric_Ring);

   function initialize_as_point         (point : Geometric_Point)
                                         return Geometry;
   function initialize_as_multi_point   (point : Geometric_Point)
                                         return Geometry;

   function initialize_as_line          (line_string : Geometric_Line_String)
                                         return Geometry;
   function initialize_as_multi_line    (line_string : Geometric_Line_String)
                                         return Geometry;

   function initialize_as_polygon       (polygon : Geometric_Polygon)
                                         return Geometry;
   function initialize_as_multi_polygon (polygon : Geometric_Polygon)
                                         return Geometry;

   function initialize_as_collection    (anything : Geometry) return Geometry;

   -----------------------------------
   --  Build collections functions  --
   -----------------------------------
   procedure augment_multi_point   (collection : in out Geometry;
                                    point      : Geometric_Point);

   procedure augment_multi_line    (collection : in out Geometry;
                                    line       : Geometric_Line_String);

   procedure augment_multi_polygon (collection : in out Geometry;
                                    polygon    : Geometric_Polygon);

   procedure augment_collection    (collection : in out Geometry;
                                    anything   : Geometry);

   ---------------------------
   --  Retrieval functions  --
   ---------------------------
   function type_of_collection     (collection : Geometry)
                                    return Collection_Type;
   function size_of_collection     (collection : Geometry)
                                    return Positive;
   function collection_item_type   (collection : Geometry;
                                    index      : Positive := 1)
                                    return Collection_Type;

   function retrieve_subcollection (collection : Geometry;
                                    index : Positive := 1)
                                    return Geometry;

   function retrieve_point         (collection : Geometry;
                                    index : Positive := 1)
                                    return Geometric_Point;
   function retrieve_line          (collection : Geometry;
                                    index : Positive := 1)
                                    return Geometric_Line_String;

   function retrieve_polygon       (collection : Geometry;
                                    index      : Positive := 1)
                                    return Geometric_Polygon;
   function number_of_rings        (polygon : Geometric_Polygon)
                                    return Natural;
   function retrieve_ring          (polygon : Geometric_Polygon;
                                    ring_index : Positive)
                                    return Geometric_Ring;

   -------------------
   --  Conversions  --
   -------------------

   function convert_infinite_line (line : Geometric_Line)
                                   return Slope_Intercept;

   function convert_infinite_line (line : Geometric_Line) return Standard_Form;

   function convert_to_infinite_line (std_form : Standard_Form)
                                      return Geometric_Line;

   function convert_to_infinite_line (intercept_form : Slope_Intercept)
                                      return Geometric_Line;

   ---------------------------
   --  Text Representation  --
   ---------------------------
   function mysql_text      (collection : Geometry;
                             top_first  : Boolean := True) return String;
   function Well_Known_Text (collection : Geometry;
                             top_first  : Boolean := True) return String;
   function dump            (collection : Geometry) return String;

   CONVERSION_FAILED       : exception;
   OUT_OF_COLLECTION_RANGE : exception;
   LACKING_POINTS          : exception;
   ILLEGAL_POLY_HOLE       : exception;
   ILLEGAL_SHAPE           : exception;

private

   subtype Geometric_Point_Collection is Geometric_Point_set;
   subtype Item_ID_type is Positive range 1 .. 2 ** 10;  -- 1024 shapes
   type collection_flags is mod 2 ** 24;

   type Ring_Structure is
      record
         Item_Type   : Collection_Type;
         Item_ID     : Item_ID_type;
         Ring_ID     : Geo_Units;
         Ring_Size   : Geo_Points;
         Ring_Count  : Geo_Units;
         Point_Index : Geo_Points;
         Level_Flags : collection_flags;
         Group_ID    : Item_ID_type;
      end record;

   type Ring_Structures is array (Positive range <>) of Ring_Structure;

   type Geometric_Polygon (rings  : Geo_Units := Geo_Units'First;
                           points : Geo_Points := Geo_Points'First) is
      record
         structures : Ring_Structures (1 .. rings);
         points_set : Geometric_Point_Collection (1 .. points) :=
                      (others => Origin_Point);
      end record;

   type Geometry (contents : Collection_Type := unset;
                  units    : Geo_Units := Geo_Units'First;
                  subunits : Geo_Units := Geo_Units'First;
                  points   : Geo_Points := Geo_Points'First) is
      record
         case contents is
            when unset => null;
            when others =>
               structures : Ring_Structures (1 .. subunits);
               points_set : Geometric_Point_Collection (1 .. points);
         end case;
      end record;

   --  returns a trimmed floating point image
   function format_real (value : Geometric_Real) return String;

   --  returns the highest value for Level Flags found
   function highest_level (collection : Geometry) return collection_flags;

   --  raises exception if index is out of range
   procedure check_collection_index (collection : Geometry; index : Positive);

   function single_canvas (gm_type  : Collection_Type;
                           items    : Item_ID_type;
                           subunits : Geo_Units;
                           points   : Geo_Points) return Geometry;

   function collection_item_shape  (collection : Geometry;
                                    index      : Positive := 1)
                                    return Geometric_Shape;

end Spatial_Data;

Make collection_item_shape private

Make collection_item_shape private

This is only used for exception message and isn't really very helpful.
Rather than remove it completely, just remove it from public view.


-----------------------------------------------------------------------
--  ADO Mysql Database -- MySQL Database connections
--  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 System;
with Mysql.Mysql;  use Mysql.Mysql;

with ADO.SQL;
with ADO.Schemas;

package ADO.Statements.Mysql is

   --  ------------------------------
   --  Delete statement
   --  ------------------------------
   type Mysql_Delete_Statement is new Delete_Statement with private;
   type Mysql_Delete_Statement_Access is access all Mysql_Delete_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Mysql_Delete_Statement;
                      Result : out Natural);

   --  Create the delete statement
   function Create_Statement (Database : in Mysql_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access;

   --  ------------------------------
   --  Update statement
   --  ------------------------------
   type Mysql_Update_Statement is new Update_Statement with private;
   type Mysql_Update_Statement_Access is access all Mysql_Update_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Mysql_Update_Statement);

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Mysql_Update_Statement;
                      Result : out Integer);

   --  Create an update statement
   function Create_Statement (Database : in Mysql_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access;

   --  ------------------------------
   --  Insert statement
   --  ------------------------------
   type Mysql_Insert_Statement is new Insert_Statement with private;
   type Mysql_Insert_Statement_Access is access all Mysql_Insert_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Mysql_Insert_Statement;
                      Result : out Integer);

   --  Create an insert statement.
   function Create_Statement (Database : in Mysql_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access;

   --  ------------------------------
   --  Query statement for MySQL
   --  ------------------------------
   type Mysql_Query_Statement is new Query_Statement with private;
   type Mysql_Query_Statement_Access is access all Mysql_Query_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Mysql_Query_Statement);

   --  Get the number of rows returned by the query
   overriding
   function Get_Row_Count (Query : in Mysql_Query_Statement) return Natural;

   --  Returns True if there is more data (row) to fetch
   overriding
   function Has_Elements (Query : in Mysql_Query_Statement) return Boolean;

   --  Fetch the next row
   overriding
   procedure Next (Query : in out Mysql_Query_Statement);

   --  Returns true if the column Column is null.
   overriding
   function Is_Null (Query  : in Mysql_Query_Statement;
                     Column : in Natural) return Boolean;

   --  Get the column value at position Column and
   --  return it as an Int64.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Int64 (Query  : Mysql_Query_Statement;
                       Column : Natural) return Int64;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Unbounded_String (Query  : Mysql_Query_Statement;
                                  Column : Natural) return Unbounded_String;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_String (Query  : Mysql_Query_Statement;
                        Column : Natural) return String;

   --  Get the column value at position Column and
   --  return it as a Blob reference.
   overriding
   function Get_Blob (Query  : in Mysql_Query_Statement;
                      Column : in Natural) return ADO.Blob_Ref;

   --  Get the column value at position Column and
   --  return it as an Time.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   function Get_Time (Query  : Mysql_Query_Statement;
                      Column : Natural) return Ada.Calendar.Time;

   --  Get the column type
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Type (Query  : Mysql_Query_Statement;
                             Column : Natural)
                             return ADO.Schemas.Column_Type;

   overriding
   procedure Finalize (Query : in out Mysql_Query_Statement);

   --  Create the query statement.
   function Create_Statement (Database : in Mysql_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access;

   function Create_Statement (Database : in Mysql_Access;
                              Query    : in String)
                              return Query_Statement_Access;

private
   type State is (HAS_ROW, HAS_MORE, DONE, ERROR);

   type Fields is array (Natural) of System.Address;
   type Row_Fields is access Fields;

   type Lengths is array (Natural) of Natural;
   type Lengths_Access is access Lengths;

   type Mysql_Query_Statement is new Query_Statement with record
      This_Query : aliased ADO.SQL.Query;
      Connection : Mysql_Access;
      Result     : MYSQL_RES;
      Row        : System_Access;
      Counter    : Natural := 1;
      Status     : State := DONE;
      Lengths    : Lengths_Access;
      Max_Column : Natural;
   end record;

   --  Get a column field address.
   --  If the query was not executed, raises Invalid_Statement
   --  If the column is out of bound, raises Constraint_Error
   function Get_Field (Query  : Mysql_Query_Statement'Class;
                       Column : Natural) return chars_ptr;

   --  Get a column field length.
   --  If the query was not executed, raises Invalid_Statement
   --  If the column is out of bound, raises Constraint_Error
   --  ------------------------------
   function Get_Field_Length (Query  : in Mysql_Query_Statement'Class;
                              Column : in Natural) return Natural;

   type Mysql_Delete_Statement is new Delete_Statement with record
      Connection   : Mysql_Access;
      Table        : ADO.Schemas.Class_Mapping_Access;
      Delete_Query : aliased ADO.SQL.Query;
   end record;

   type Mysql_Update_Statement is new Update_Statement with record
      Connection : Mysql_Access;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

   type Mysql_Insert_Statement is new Insert_Statement with record
      Connection : Mysql_Access;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

end ADO.Statements.Mysql;

-----------------------------------------------------------------------
--  ADO Mysql Database -- MySQL Database connections
--  Copyright (C) 2009, 2010, 2011, 2012, 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 System;
with Mysql.Mysql;  use Mysql.Mysql;

with ADO.SQL;
with ADO.Schemas;

package ADO.Statements.Mysql is

   --  ------------------------------
   --  Delete statement
   --  ------------------------------
   type Mysql_Delete_Statement is new Delete_Statement with private;
   type Mysql_Delete_Statement_Access is access all Mysql_Delete_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Mysql_Delete_Statement;
                      Result : out Natural);

   --  Create the delete statement
   function Create_Statement (Database : in Mysql_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access;

   --  ------------------------------
   --  Update statement
   --  ------------------------------
   type Mysql_Update_Statement is new Update_Statement with private;
   type Mysql_Update_Statement_Access is access all Mysql_Update_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Mysql_Update_Statement);

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Mysql_Update_Statement;
                      Result : out Integer);

   --  Create an update statement
   function Create_Statement (Database : in Mysql_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access;

   --  ------------------------------
   --  Insert statement
   --  ------------------------------
   type Mysql_Insert_Statement is new Insert_Statement with private;
   type Mysql_Insert_Statement_Access is access all Mysql_Insert_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Mysql_Insert_Statement;
                      Result : out Integer);

   --  Create an insert statement.
   function Create_Statement (Database : in Mysql_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access;

   --  ------------------------------
   --  Query statement for MySQL
   --  ------------------------------
   type Mysql_Query_Statement is new Query_Statement with private;
   type Mysql_Query_Statement_Access is access all Mysql_Query_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Mysql_Query_Statement);

   --  Get the number of rows returned by the query
   overriding
   function Get_Row_Count (Query : in Mysql_Query_Statement) return Natural;

   --  Returns True if there is more data (row) to fetch
   overriding
   function Has_Elements (Query : in Mysql_Query_Statement) return Boolean;

   --  Fetch the next row
   overriding
   procedure Next (Query : in out Mysql_Query_Statement);

   --  Returns true if the column Column is null.
   overriding
   function Is_Null (Query  : in Mysql_Query_Statement;
                     Column : in Natural) return Boolean;

   --  Get the column value at position Column and
   --  return it as an Int64.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Int64 (Query  : Mysql_Query_Statement;
                       Column : Natural) return Int64;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Unbounded_String (Query  : Mysql_Query_Statement;
                                  Column : Natural) return Unbounded_String;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_String (Query  : Mysql_Query_Statement;
                        Column : Natural) return String;

   --  Get the column value at position Column and
   --  return it as a Blob reference.
   overriding
   function Get_Blob (Query  : in Mysql_Query_Statement;
                      Column : in Natural) return ADO.Blob_Ref;

   --  Get the column value at position Column and
   --  return it as an Time.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   function Get_Time (Query  : Mysql_Query_Statement;
                      Column : Natural) return Ada.Calendar.Time;

   --  Get the column type
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Type (Query  : Mysql_Query_Statement;
                             Column : Natural)
                             return ADO.Schemas.Column_Type;

   --  Get the column name.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Name (Query  : in Mysql_Query_Statement;
                             Column : in Natural)
                             return String;

   --  Get the number of columns in the result.
   overriding
   function Get_Column_Count (Query  : in Mysql_Query_Statement)
                              return Natural;

   overriding
   procedure Finalize (Query : in out Mysql_Query_Statement);

   --  Create the query statement.
   function Create_Statement (Database : in Mysql_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access;

   function Create_Statement (Database : in Mysql_Access;
                              Query    : in String)
                              return Query_Statement_Access;

private
   type State is (HAS_ROW, HAS_MORE, DONE, ERROR);

   type Fields is array (Natural) of System.Address;
   type Row_Fields is access Fields;

   type Lengths is array (Natural) of Natural;
   type Lengths_Access is access Lengths;

   type Mysql_Query_Statement is new Query_Statement with record
      This_Query : aliased ADO.SQL.Query;
      Connection : Mysql_Access;
      Result     : MYSQL_RES;
      Row        : System_Access;
      Counter    : Natural := 1;
      Status     : State := DONE;
      Lengths    : Lengths_Access;
      Max_Column : Natural;
   end record;

   --  Get a column field address.
   --  If the query was not executed, raises Invalid_Statement
   --  If the column is out of bound, raises Constraint_Error
   function Get_Field (Query  : Mysql_Query_Statement'Class;
                       Column : Natural) return chars_ptr;

   --  Get a column field length.
   --  If the query was not executed, raises Invalid_Statement
   --  If the column is out of bound, raises Constraint_Error
   --  ------------------------------
   function Get_Field_Length (Query  : in Mysql_Query_Statement'Class;
                              Column : in Natural) return Natural;

   type Mysql_Delete_Statement is new Delete_Statement with record
      Connection   : Mysql_Access;
      Table        : ADO.Schemas.Class_Mapping_Access;
      Delete_Query : aliased ADO.SQL.Query;
   end record;

   type Mysql_Update_Statement is new Update_Statement with record
      Connection : Mysql_Access;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

   type Mysql_Insert_Statement is new Insert_Statement with record
      Connection : Mysql_Access;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

end ADO.Statements.Mysql;

Define the Get_Column_Name and Get_Column_Count operation in the MySQL driver


------------------------------------------------------------------------------
--                                                                          --
--                    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 STMicroelectronics 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.   --
--                                                                          --
------------------------------------------------------------------------------

--  This file provides declarations for devices on the STM32F469 Discovery kits
--  manufactured by ST Microelectronics.

with STM32.Device;  use STM32.Device;

with STM32.GPIO;    use STM32.GPIO;
--  with STM32.SPI;     use STM32.SPI;
with STM32.ADC;     use STM32.ADC;
with STM32.FMC;     use STM32.FMC;

with Ada.Interrupts.Names;  use Ada.Interrupts;

use STM32;  -- for base addresses

package STM32.Board is

   pragma Elaborate_Body;

   subtype User_LED is GPIO_Point;

   LED1      : User_Led renames PG6;
   LED2      : User_LED renames PD4;
   LED3      : User_LED renames PD5;
   LED4      : User_LED renames PK3;

   Green     : User_LED renames LED1;
   Orange    : User_LED renames LED2;
   Red       : User_LED renames LED3;
   Blue      : User_LED renames LED4;

   LCH_LED   : User_LED renames Red;

   All_LEDs  : constant GPIO_Points := LED1 & LED2 & LED3 & LED4;

   procedure Initialize_LEDs;
   --  MUST be called prior to any use of the LEDs

   procedure Turn_On (This : User_LED)
     renames STM32.GPIO.Clear;
   procedure Turn_Off (This : User_LED)
     renames STM32.GPIO.Set;

   procedure All_LEDs_Off with Inline;
   procedure All_LEDs_On  with Inline;
   procedure Toggle_LEDs (These : GPIO_Points)
     renames STM32.GPIO.Toggle;

--     Gyro : Three_Axis_Gyroscope;

   --  GPIO Pins for FMC

   FMC_D : constant GPIO_Points :=
             (PD14, PD15, PD0, PD1, PE7, PE8, PE9, PE10,
              PE11, PE12, PE13, PE14, PE15, PD8, PD9, PD10,
              PH8, PH9, PH10, PH11, PH12, PH13, PH14, PH15,
              PI0, PI1, PI2, PI3, PI6, PI7, PI9, PI10);

   FMC_A : constant GPIO_Points :=
              (PF0, PF1, PF2, PF3, PF4, PF5,
               PF12, PF13, PF14, PF15, PG0, PG1, PG4, PG5);

   FMC_SDNWE  : GPIO_Point renames PC0;
   FMC_SDNRAS : GPIO_Point renames PF11;
   FMC_SDNCAS : GPIO_Point renames PG15;
   FMC_SDNE0  : GPIO_Point renames PH3;
   FMC_SDCKE0 : GPIO_Point renames PH2;
   FMC_SDCLK  : GPIO_Point renames PG8;

   FMC_NBL0   : GPIO_Point renames PE0;
   FMC_NBL1   : GPIO_Point renames PE1;
   FMC_NBL2   : GPIO_Point renames PI4;
   FMC_NBL3   : GPIO_Point renames PI5;

   SDRAM_PINS    : constant GPIO_Points :=
                     FMC_A & FMC_D &
                     FMC_SDNWE & FMC_SDNRAS & FMC_SDNCAS & FMC_SDCLK &
                     FMC_SDNE0 & FMC_SDCKE0 & FMC_NBL0 & FMC_NBL1 &
                     FMC_NBL2 & FMC_NBL3;

   --  SDRAM CONFIGURATION Parameters
   SDRAM_Base         : constant := 16#C0000000#;
   SDRAM_Size         : constant := 16#800000#;
   SDRAM_Bank         : constant STM32.FMC.FMC_SDRAM_Cmd_Target_Bank :=
                          STM32.FMC.FMC_Bank1_SDRAM;
   SDRAM_Mem_Width    : constant STM32.FMC.FMC_SDRAM_Memory_Bus_Width :=
                          STM32.FMC.FMC_SDMemory_Width_32b;
   SDRAM_Row_Bits     : constant STM32.FMC.FMC_SDRAM_Row_Address_Bits :=
                          FMC_RowBits_Number_12b;
   SDRAM_CAS_Latency  : constant STM32.FMC.FMC_SDRAM_CAS_Latency :=
                          STM32.FMC.FMC_CAS_Latency_3;
   SDRAM_CLOCK_Period : constant STM32.FMC.FMC_SDRAM_Clock_Configuration :=
                          STM32.FMC.FMC_SDClock_Period_2;
   SDRAM_Read_Burst   : constant STM32.FMC.FMC_SDRAM_Burst_Read :=
                          STM32.FMC.FMC_Read_Burst_Single;
   SDRAM_Read_Pipe    : constant STM32.FMC.FMC_SDRAM_Read_Pipe_Delay :=
                          STM32.FMC.FMC_ReadPipe_Delay_0;
   SDRAM_Refresh_Cnt  : constant := 1385;

   ---------------
   -- SPI5 Pins --
   ---------------

--     SPI5_SCK     : GPIO_Point renames PF7;
--     SPI5_MISO    : GPIO_Point renames PF8;
--     SPI5_MOSI    : GPIO_Point renames PF9;
--     NCS_MEMS_SPI : GPIO_Point renames PC1;
--     MEMS_INT1    : GPIO_Point renames PA1;
--     MEMS_INT2    : GPIO_Point renames PA2;
--     LCD_SPI      : SPI_Port   renames SPI_5;

   ------------------------
   --  GPIO Pins for LCD --
   ------------------------

   LCD_XRES    : GPIO_Point renames PH7;
   LCD_BL_CTRL : GPIO_Point renames PA3;
   DSIHOST_TE  : GPIO_Point renames PJ2;

   --  User button

   User_Button_Point     : GPIO_Point renames PA0;
   User_Button_Interrupt : constant Interrupt_Id := Names.EXTI0_Interrupt;

   procedure Configure_User_Button_GPIO;
   --  Configures the GPIO port/pin for the blue user button. Sufficient
   --  for polling the button, and necessary for having the button generate
   --  interrupts.

end STM32.Board;

------------------------------------------------------------------------------
--                                                                          --
--                    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 STMicroelectronics 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.   --
--                                                                          --
------------------------------------------------------------------------------

--  This file provides declarations for devices on the STM32F469 Discovery kits
--  manufactured by ST Microelectronics.

with STM32.Device;  use STM32.Device;

with STM32.GPIO;    use STM32.GPIO;
--  with STM32.SPI;     use STM32.SPI;
with STM32.ADC;     use STM32.ADC;
with STM32.FMC;     use STM32.FMC;

with Ada.Interrupts.Names;  use Ada.Interrupts;

use STM32;  -- for base addresses

package STM32.Board is

   pragma Elaborate_Body;

   subtype User_LED is GPIO_Point;

   LED1      : User_Led renames PG6;
   LED2      : User_LED renames PD4;
   LED3      : User_LED renames PD5;
   LED4      : User_LED renames PK3;

   Green     : User_LED renames LED1;
   Orange    : User_LED renames LED2;
   Red       : User_LED renames LED3;
   Blue      : User_LED renames LED4;

   LCH_LED   : User_LED renames Red;

   All_LEDs  : constant GPIO_Points := LED1 & LED2 & LED3 & LED4;

   procedure Initialize_LEDs;
   --  MUST be called prior to any use of the LEDs

   procedure Turn_On (This : User_LED)
     renames STM32.GPIO.Clear;
   procedure Turn_Off (This : User_LED)
     renames STM32.GPIO.Set;

   procedure All_LEDs_Off with Inline;
   procedure All_LEDs_On  with Inline;
   procedure Toggle_LEDs (These : GPIO_Points)
     renames STM32.GPIO.Toggle;

--     Gyro : Three_Axis_Gyroscope;

   --  GPIO Pins for FMC

   FMC_D : constant GPIO_Points :=
             (PD14, PD15, PD0, PD1, PE7, PE8, PE9, PE10,
              PE11, PE12, PE13, PE14, PE15, PD8, PD9, PD10,
              PH8, PH9, PH10, PH11, PH12, PH13, PH14, PH15,
              PI0, PI1, PI2, PI3, PI6, PI7, PI9, PI10);

   FMC_A : constant GPIO_Points :=
              (PF0, PF1, PF2, PF3, PF4, PF5,
               PF12, PF13, PF14, PF15, PG0, PG1, PG4, PG5);

   FMC_SDNWE  : GPIO_Point renames PC0;
   FMC_SDNRAS : GPIO_Point renames PF11;
   FMC_SDNCAS : GPIO_Point renames PG15;
   FMC_SDNE0  : GPIO_Point renames PH3;
   FMC_SDCKE0 : GPIO_Point renames PH2;
   FMC_SDCLK  : GPIO_Point renames PG8;

   FMC_NBL0   : GPIO_Point renames PE0;
   FMC_NBL1   : GPIO_Point renames PE1;
   FMC_NBL2   : GPIO_Point renames PI4;
   FMC_NBL3   : GPIO_Point renames PI5;

   SDRAM_PINS    : constant GPIO_Points :=
                     FMC_A & FMC_D &
                     FMC_SDNWE & FMC_SDNRAS & FMC_SDNCAS & FMC_SDCLK &
                     FMC_SDNE0 & FMC_SDCKE0 & FMC_NBL0 & FMC_NBL1 &
                     FMC_NBL2 & FMC_NBL3;

   --  SDRAM CONFIGURATION Parameters
   SDRAM_Base         : constant := 16#C0000000#;
   SDRAM_Size         : constant := 16#800000#;
   SDRAM_Bank         : constant STM32.FMC.FMC_SDRAM_Cmd_Target_Bank :=
                          STM32.FMC.FMC_Bank1_SDRAM;
   SDRAM_Mem_Width    : constant STM32.FMC.FMC_SDRAM_Memory_Bus_Width :=
                          STM32.FMC.FMC_SDMemory_Width_32b;
   SDRAM_Row_Bits     : constant STM32.FMC.FMC_SDRAM_Row_Address_Bits :=
                          FMC_RowBits_Number_11b;
   SDRAM_CAS_Latency  : constant STM32.FMC.FMC_SDRAM_CAS_Latency :=
                          STM32.FMC.FMC_CAS_Latency_3;
   SDRAM_CLOCK_Period : constant STM32.FMC.FMC_SDRAM_Clock_Configuration :=
                          STM32.FMC.FMC_SDClock_Period_2;
   SDRAM_Read_Burst   : constant STM32.FMC.FMC_SDRAM_Burst_Read :=
                          STM32.FMC.FMC_Read_Burst_Single;
   SDRAM_Read_Pipe    : constant STM32.FMC.FMC_SDRAM_Read_Pipe_Delay :=
                          STM32.FMC.FMC_ReadPipe_Delay_0;
   SDRAM_Refresh_Cnt  : constant := 1385;

   ---------------
   -- SPI5 Pins --
   ---------------

--     SPI5_SCK     : GPIO_Point renames PF7;
--     SPI5_MISO    : GPIO_Point renames PF8;
--     SPI5_MOSI    : GPIO_Point renames PF9;
--     NCS_MEMS_SPI : GPIO_Point renames PC1;
--     MEMS_INT1    : GPIO_Point renames PA1;
--     MEMS_INT2    : GPIO_Point renames PA2;
--     LCD_SPI      : SPI_Port   renames SPI_5;

   ------------------------
   --  GPIO Pins for LCD --
   ------------------------

   LCD_XRES    : GPIO_Point renames PH7;
   LCD_BL_CTRL : GPIO_Point renames PA3;
   DSIHOST_TE  : GPIO_Point renames PJ2;

   --  User button

   User_Button_Point     : GPIO_Point renames PA0;
   User_Button_Interrupt : constant Interrupt_Id := Names.EXTI0_Interrupt;

   procedure Configure_User_Button_GPIO;
   --  Configures the GPIO port/pin for the blue user button. Sufficient
   --  for polling the button, and necessary for having the button generate
   --  interrupts.

end STM32.Board;

Fix SDRAM parameters for the STM32F469-Disco board.


-----------------------------------------------------------------------
--  util-encoders-aes -- AES encryption and decryption
--  Copyright (C) 2017, 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 Interfaces;
private with Ada.Finalization;

--  The Util.Encodes.SHA1 package generates SHA-1 hash according to
--  RFC3174 or [FIPS-180-1].
package Util.Encoders.AES is

   type AES_Mode is (ECB, CBC, PCBC, CFB, OFB, CTR);

   type AES_Padding is (NO_PADDING, PKCS7_PADDING);

   type Key_Type is private;

   --  ------------------------------
   --  ------------------------------
   subtype Block_Type is Ada.Streams.Stream_Element_Array (1 .. 16);

   AES_128_Length : constant := 16;
   AES_192_Length : constant := 24;
   AES_256_Length : constant := 32;

   subtype AES_128_Key is Ada.Streams.Stream_Element_Array (1 .. 16);
   subtype AES_192_Key is Ada.Streams.Stream_Element_Array (1 .. 24);
   subtype AES_256_Key is Ada.Streams.Stream_Element_Array (1 .. 32);

   type Word_Block_Type is array (1 .. 4) of Interfaces.Unsigned_32;

   procedure Set_Encrypt_Key (Key  : out Key_Type;
                              Data : in Secret_Key)
     with Pre => Data.Length = 16 or Data.Length = 24 or Data.Length = 32;

   procedure Set_Decrypt_Key (Key  : out Key_Type;
                              Data : in Secret_Key)
     with Pre => Data.Length = 16 or Data.Length = 24 or Data.Length = 32;

   procedure Encrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);
   procedure Encrypt (Input  : in Word_Block_Type;
                      Output : out Word_Block_Type;
                      Key    : in Key_Type);

   procedure Encrypt (Input  : in Ada.Streams.Stream_Element_Array;
                      Output : out Ada.Streams.Stream_Element_Array;
                      Last   : out Ada.Streams.Stream_Element_Offset;
                      Key    : in Key_Type);

   procedure Decrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);

   procedure Decrypt (Input  : in Word_Block_Type;
                      Output : out Word_Block_Type;
                      Key    : in Key_Type);

   type Cipher is tagged limited private;

   --  Set the encryption initialization vector before starting the encryption.
   procedure Set_IV (E  : in out Cipher;
                     IV : in Word_Block_Type);

   --  ------------------------------
   --  AES encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an SHA1 hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Encoder is new Cipher and Util.Encoders.Transformer with private;

   --  Set the encryption key to use.
   procedure Set_Key (E    : in out Encoder;
                      Data : in Secret_Key;
                      Mode : in AES_Mode := CBC);

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Finish encoding the input array.
   overriding
   procedure Finish (E    : in out Encoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset)
     with Pre => Into'Length >= Block_Type'Length,
     Post => Last = Into'First - 1 or Last = Into'First + Block_Type'Length - 1;

   --  Encrypt the secret using the encoder and return the encrypted value in the buffer.
   procedure Encrypt_Secret (E      : in out Encoder;
                             Secret : in Secret_Key;
                             Into   : out Ada.Streams.Stream_Element_Array);

   --  ------------------------------
   --  AES encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an SHA1 hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Decoder is new Cipher and Util.Encoders.Transformer with private;

   --  Set the decryption key to use.
   procedure Set_Key (E    : in out Decoder;
                      Data : in Secret_Key;
                      Mode : in AES_Mode := CBC);

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Decoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Finish encoding the input array.
   overriding
   procedure Finish (E    : in out Decoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset);

   --  Decrypt the content using the decoder and build the secret key.
   procedure Decrypt_Secret (E      : in out Decoder;
                             Data   : in Ada.Streams.Stream_Element_Array;
                             Secret : out Secret_Key);

private

   use Interfaces;

   subtype Count_Type is Ada.Streams.Stream_Element_Offset range 0 .. 16;

   type Block_Key is array (0 .. 59) of Unsigned_32;

   type Key_Type is record
      Key    : Block_Key := (others => 0);
      Rounds : Natural := 0;
   end record;

   type Cipher is limited new Ada.Finalization.Limited_Controlled with record
      IV         : Word_Block_Type := (others => 0);
      Key        : Key_Type;
      Mode       : AES_Mode := CBC;
      Padding    : AES_Padding := PKCS7_PADDING;
      Data_Count : Count_Type := 0;
      Data       : Block_Type;
      Data2      : Block_Type;
   end record;

   overriding
   procedure Finalize (Object : in out Cipher);

   type Encoder is new Cipher and Util.Encoders.Transformer with null record;

   type Decoder is new Cipher and Util.Encoders.Transformer with null record;

end Util.Encoders.AES;

-----------------------------------------------------------------------
--  util-encoders-aes -- AES encryption and decryption
--  Copyright (C) 2017, 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 Interfaces;
private with Ada.Finalization;

--  The Util.Encodes.SHA1 package generates SHA-1 hash according to
--  RFC3174 or [FIPS-180-1].
package Util.Encoders.AES is

   type AES_Mode is (ECB, CBC, PCBC, CFB, OFB, CTR);

   type AES_Padding is (NO_PADDING, ZERO_PADDING, PKCS7_PADDING);

   type Key_Type is private;

   --  ------------------------------
   --  ------------------------------
   subtype Block_Type is Ada.Streams.Stream_Element_Array (1 .. 16);

   AES_128_Length : constant := 16;
   AES_192_Length : constant := 24;
   AES_256_Length : constant := 32;

   subtype AES_128_Key is Ada.Streams.Stream_Element_Array (1 .. 16);
   subtype AES_192_Key is Ada.Streams.Stream_Element_Array (1 .. 24);
   subtype AES_256_Key is Ada.Streams.Stream_Element_Array (1 .. 32);

   type Word_Block_Type is array (1 .. 4) of Interfaces.Unsigned_32;

   procedure Set_Encrypt_Key (Key  : out Key_Type;
                              Data : in Secret_Key)
     with Pre => Data.Length = 16 or Data.Length = 24 or Data.Length = 32;

   procedure Set_Decrypt_Key (Key  : out Key_Type;
                              Data : in Secret_Key)
     with Pre => Data.Length = 16 or Data.Length = 24 or Data.Length = 32;

   procedure Encrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);
   procedure Encrypt (Input  : in Word_Block_Type;
                      Output : out Word_Block_Type;
                      Key    : in Key_Type);

   procedure Encrypt (Input  : in Ada.Streams.Stream_Element_Array;
                      Output : out Ada.Streams.Stream_Element_Array;
                      Last   : out Ada.Streams.Stream_Element_Offset;
                      Key    : in Key_Type);

   procedure Decrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);

   procedure Decrypt (Input  : in Word_Block_Type;
                      Output : out Word_Block_Type;
                      Key    : in Key_Type);

   type Cipher is tagged limited private;

   --  Set the encryption initialization vector before starting the encryption.
   procedure Set_IV (E  : in out Cipher;
                     IV : in Word_Block_Type);

   --  Set the padding.
   procedure Set_Padding (E       : in out Cipher;
                          Padding : in AES_Padding);

   --  Get the padding used.
   function Padding (E : in Cipher) return AES_Padding;

   --  Return true if the cipher has a encryption/decryption key configured.
   function Has_Key (E : in Cipher) return Boolean;

   --  ------------------------------
   --  AES encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an SHA1 hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Encoder is new Cipher and Util.Encoders.Transformer with private;

   --  Set the encryption key to use.
   procedure Set_Key (E    : in out Encoder;
                      Data : in Secret_Key;
                      Mode : in AES_Mode := CBC);

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) with
     Pre => E.Has_Key;

   --  Finish encoding the input array.
   overriding
   procedure Finish (E    : in out Encoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset) with
     Pre  => E.Has_Key and Into'Length >= Block_Type'Length,
     Post => Last = Into'First - 1 or Last = Into'First + Block_Type'Length - 1;

   --  Encrypt the secret using the encoder and return the encrypted value in the buffer.
   --  The target buffer must be a multiple of 16-bytes block.
   procedure Encrypt_Secret (E      : in out Encoder;
                             Secret : in Secret_Key;
                             Into   : out Ada.Streams.Stream_Element_Array) with
     Pre => Into'Length mod 16 = 0 and
     (case E.Padding is
        when NO_PADDING => Secret.Length = Into'Length,
          when PKCS7_PADDING | ZERO_PADDING => 16 * (1 + (Secret.Length / 16)) = Into'Length);

   --  ------------------------------
   --  AES encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an SHA1 hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Decoder is new Cipher and Util.Encoders.Transformer with private;

   --  Set the decryption key to use.
   procedure Set_Key (E    : in out Decoder;
                      Data : in Secret_Key;
                      Mode : in AES_Mode := CBC);

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Decoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) with
     Pre => E.Has_Key;

   --  Finish encoding the input array.
   overriding
   procedure Finish (E    : in out Decoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset);

   --  Decrypt the content using the decoder and build the secret key.
   procedure Decrypt_Secret (E      : in out Decoder;
                             Data   : in Ada.Streams.Stream_Element_Array;
                             Secret : in out Secret_Key) with
     Pre => Data'Length mod 16 = 0 and
     (case E.Padding is
        when NO_PADDING => Secret.Length = Data'Length,
          when PKCS7_PADDING | ZERO_PADDING => 16 * (1 + (Secret.Length / 16)) = Data'Length);

private

   use Interfaces;

   subtype Count_Type is Ada.Streams.Stream_Element_Offset range 0 .. 16;

   type Block_Key is array (0 .. 59) of Unsigned_32;

   type Key_Type is record
      Key    : Block_Key := (others => 0);
      Rounds : Natural := 0;
   end record;

   type Cipher is limited new Ada.Finalization.Limited_Controlled with record
      IV         : Word_Block_Type := (others => 0);
      Key        : Key_Type;
      Mode       : AES_Mode := CBC;
      Padding    : AES_Padding := PKCS7_PADDING;
      Data_Count : Count_Type := 0;
      Data       : Block_Type;
      Data2      : Block_Type;
   end record;

   overriding
   procedure Finalize (Object : in out Cipher);

   type Encoder is new Cipher and Util.Encoders.Transformer with null record;

   type Decoder is new Cipher and Util.Encoders.Transformer with null record;

end Util.Encoders.AES;

Add Set_Padding, Has_Padding and Has_Key operations Add preconditions on Encrypt_Secret, Decrypt_Secret and Transform


-----------------------------------------------------------------------
--  Logs -- Utility Log Package
--  Copyright (C) 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
--  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.Exceptions;
with Ada.Strings.Unbounded;

with Util.Log.Appenders;
with Util.Properties;
with Ada.Finalization;
package Util.Log.Loggers is

   use Ada.Exceptions;
   use Ada.Strings.Unbounded;

   --  The logger identifies and configures the log produced
   --  by a component that uses it.  The logger has a name
   --  which can be printed in the log outputs.  The logger instance
   --  contains a log level which can be used to control the level of
   --  logs.
   type Logger is tagged limited private;
   type Logger_Access is access constant Logger;

   --  Create a logger with the given name.
   function Create (Name : in String) return Logger;

   --  Create a logger with the given name and use the specified level.
   function Create (Name  : in String;
                    Level : in Level_Type) return Logger;

   --  Initialize the logger and create a logger with the given name.
   function Create (Name   : in String;
                    Config : in String) return Logger;

   --  Change the log level
   procedure Set_Level (Log   : in out Logger;
                        Level : in Level_Type);

   --  Get the log level.
   function Get_Level (Log : in Logger) return Level_Type;

   --  Get the log level name.
   function Get_Level_Name (Log : in Logger) return String;

   procedure Print (Log     : in Logger;
                    Level   : in Level_Type;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "";
                    Arg3    : in String := "";
                    Arg4    : in String := "");

   procedure Debug (Log     : in Logger'Class;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "";
                    Arg3    : in String := "");

   procedure Debug (Log     : in Logger'Class;
                    Message : in String;
                    Arg1    : in Unbounded_String;
                    Arg2    : in String := "";
                    Arg3    : in String := "");

   procedure Debug (Log     : in Logger'Class;
                    Message : in String;
                    Arg1    : in Unbounded_String;
                    Arg2    : in Unbounded_String;
                    Arg3    : in String := "");

   procedure Info (Log     : in Logger'Class;
                   Message : in String;
                   Arg1    : in String := "";
                   Arg2    : in String := "";
                   Arg3    : in String := "");

   procedure Info (Log     : in Logger'Class;
                   Message : in String;
                   Arg1    : in Unbounded_String;
                   Arg2    : in String := "";
                   Arg3    : in String := "");

   procedure Warn (Log     : in Logger'Class;
                   Message : in String;
                   Arg1    : in String := "";
                   Arg2    : in String := "";
                   Arg3    : in String := "");

   procedure Error (Log     : in Logger'Class;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "";
                    Arg3    : in String := "");

   procedure Error (Log     : in Logger'Class;
                    Message : in String;
                    E       : in Exception_Occurrence;
                    Trace   : in Boolean := False);

   --  Set the appender that will handle the log events
   procedure Set_Appender (Log      : in out Logger'Class;
                           Appender : in Util.Log.Appenders.Appender_Access);

   --  Initialize the log environment with the property file.
   procedure Initialize (Name : in String);

   --  Initialize the log environment with the properties.
   procedure Initialize (Properties : in Util.Properties.Manager);

   type Logger_Info (<>) is limited private;

   --  Get the logger name.
   function Get_Logger_Name (Log : in Logger_Info) return String;

   --  Return a printable traceback that correspond to the exception.
   function Traceback (E : in Exception_Occurrence) return String;

private

   type Logger_Info_Access is access all Logger_Info;

   type Logger_Info (Len : Positive) is record
      Next_Logger : Logger_Info_Access;
      Prev_Logger : Logger_Info_Access;
      Level       : Level_Type := INFO_LEVEL;
      Appender    : Util.Log.Appenders.Appender_Access;
      Name        : String (1 .. Len);
   end record;

   type Logger is new Ada.Finalization.Limited_Controlled with record
      Instance : Logger_Info_Access;
   end record;

   --  Finalize the logger and flush the associated appender
   overriding
   procedure Finalize (Log : in out Logger);

end Util.Log.Loggers;

-----------------------------------------------------------------------
--  util-log-loggers -- Utility Log Package
--  Copyright (C) 2006, 2008, 2009, 2011, 2018 Free Software Foundation, Inc.
--  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.Exceptions;
with Ada.Strings.Unbounded;

with Util.Log.Appenders;
with Util.Properties;
with Ada.Finalization;
package Util.Log.Loggers is

   use Ada.Exceptions;
   use Ada.Strings.Unbounded;

   --  The logger identifies and configures the log produced
   --  by a component that uses it.  The logger has a name
   --  which can be printed in the log outputs.  The logger instance
   --  contains a log level which can be used to control the level of
   --  logs.
   type Logger is tagged limited private;
   type Logger_Access is access constant Logger;

   --  Create a logger with the given name.
   function Create (Name : in String) return Logger;

   --  Create a logger with the given name and use the specified level.
   function Create (Name  : in String;
                    Level : in Level_Type) return Logger;

   --  Initialize the logger and create a logger with the given name.
   function Create (Name   : in String;
                    Config : in String) return Logger;

   --  Change the log level
   procedure Set_Level (Log   : in out Logger;
                        Level : in Level_Type);

   --  Get the log level.
   function Get_Level (Log : in Logger) return Level_Type;

   --  Get the log level name.
   function Get_Level_Name (Log : in Logger) return String;

   procedure Print (Log     : in Logger;
                    Level   : in Level_Type;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "";
                    Arg3    : in String := "";
                    Arg4    : in String := "");

   procedure Debug (Log     : in Logger'Class;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "";
                    Arg3    : in String := "");

   procedure Debug (Log     : in Logger'Class;
                    Message : in String;
                    Arg1    : in Unbounded_String;
                    Arg2    : in String := "";
                    Arg3    : in String := "");

   procedure Debug (Log     : in Logger'Class;
                    Message : in String;
                    Arg1    : in Unbounded_String;
                    Arg2    : in Unbounded_String;
                    Arg3    : in String := "");

   procedure Info (Log     : in Logger'Class;
                   Message : in String;
                   Arg1    : in String := "";
                   Arg2    : in String := "";
                   Arg3    : in String := "");

   procedure Info (Log     : in Logger'Class;
                   Message : in String;
                   Arg1    : in Unbounded_String;
                   Arg2    : in String := "";
                   Arg3    : in String := "");

   procedure Warn (Log     : in Logger'Class;
                   Message : in String;
                   Arg1    : in String := "";
                   Arg2    : in String := "";
                   Arg3    : in String := "");

   procedure Error (Log     : in Logger'Class;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "";
                    Arg3    : in String := "");

   procedure Error (Log     : in Logger'Class;
                    Message : in String;
                    E       : in Exception_Occurrence;
                    Trace   : in Boolean := False);

   --  Set the appender that will handle the log events
   procedure Set_Appender (Log      : in out Logger'Class;
                           Appender : in Util.Log.Appenders.Appender_Access);

   --  Initialize the log environment with the property file.
   procedure Initialize (Name : in String);

   --  Initialize the log environment with the properties.
   procedure Initialize (Properties : in Util.Properties.Manager);

   type Logger_Info (<>) is limited private;

   --  Get the logger name.
   function Get_Logger_Name (Log : in Logger_Info) return String;

   --  Return a printable traceback that correspond to the exception.
   function Traceback (E : in Exception_Occurrence) return String;

private

   type Logger_Info_Access is access all Logger_Info;

   type Logger_Info (Len : Positive) is record
      Next_Logger : Logger_Info_Access;
      Prev_Logger : Logger_Info_Access;
      Level       : Level_Type := INFO_LEVEL;
      Appender    : Util.Log.Appenders.Appender_Access;
      Name        : String (1 .. Len);
   end record;

   type Logger is new Ada.Finalization.Limited_Controlled with record
      Instance : Logger_Info_Access;
   end record;

   --  Finalize the logger and flush the associated appender
   overriding
   procedure Finalize (Log : in out Logger);

end Util.Log.Loggers;

Fix header style

Fix header style


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

   --  ------------------------------
   --  Set the output writer.
   --  ------------------------------
   procedure Set_Output_Stream (Engine : in out Text_Renderer;
                                Stream : in Streams.Output_Stream_Access) is
   begin
      Engine.Output := Stream;
   end Set_Output_Stream;

   --  ------------------------------
   --  Emit a new line.
   --  ------------------------------
   procedure New_Line (Document : in out Text_Renderer) is
   begin
      Document.Output.Write (Wiki.Helpers.LF);
      Document.Empty_Line := True;
   end New_Line;

   --  ------------------------------
   --  Add a line break (<br>).
   --  ------------------------------
   procedure Add_Line_Break (Document : in out Text_Renderer) is
   begin
      Document.Output.Write (Wiki.Helpers.LF);
      Document.Empty_Line := True;
   end Add_Line_Break;

   --  ------------------------------
   --  Render a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Render_Blockquote (Engine : in out Text_Renderer;
                                Level  : in Natural) is
   begin
      Engine.Close_Paragraph;
      for I in 1 .. Level loop
         Engine.Output.Write ("  ");
      end loop;
   end Render_Blockquote;

   --  ------------------------------
   --  Render a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Render_List_Item (Engine   : in out Text_Renderer;
                               Level    : in Positive;
                               Ordered  : in Boolean) is
      pragma Unreferenced (Level, Ordered);
   begin
      if not Engine.Empty_Line then
         Engine.Add_Line_Break;
      end if;
      Engine.Need_Paragraph := False;
      Engine.Open_Paragraph;
   end Render_List_Item;

   procedure Close_Paragraph (Document : in out Text_Renderer) is
   begin
      if Document.Has_Paragraph then
         Document.Add_Line_Break;
      end if;
      Document.Has_Paragraph := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Text_Renderer) is
   begin
      if Document.Need_Paragraph then
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Render a link.
   --  ------------------------------
   procedure Render_Link (Engine : in out Text_Renderer;
                          Title  : in Wiki.Strings.WString;
                          Attr   : in Wiki.Attributes.Attribute_List) is
      Href : constant Wiki.Strings.WString := Wiki.Attributes.Get_Attribute (Attr, "href");
   begin
      Engine.Open_Paragraph;
      if Title'Length /= 0 then
         Engine.Output.Write (Title);
      end if;
      if Title /= Href and Href'Length /= 0 then
         if Title'Length /= 0 then
            Engine.Output.Write (" (");
         end if;
         Engine.Output.Write (Href);
         if Title'Length /= 0 then
            Engine.Output.Write (")");
         end if;
      end if;
      Engine.Empty_Line := False;
   end Render_Link;

   --  ------------------------------
   --  Render an image.
   --  ------------------------------
   procedure Render_Image (Engine   : in out Text_Renderer;
                           Title    : in Wiki.Strings.WString;
                           Attr     : in Wiki.Attributes.Attribute_List) is
      Desc : constant Wiki.Strings.WString := Wiki.Attributes.Get_Attribute (Attr, "longdesc");
   begin
      Engine.Open_Paragraph;
      if Title'Length > 0 then
         Engine.Output.Write (Title);
      end if;
      if Title'Length > 0 and Desc'Length > 0 then
         Engine.Output.Write (' ');
      end if;
      if Desc'Length > 0 then
         Engine.Output.Write (Desc);
      end if;
      Engine.Empty_Line := False;
   end Render_Image;

   --  ------------------------------
   --  Render a text block that is pre-formatted.
   --  ------------------------------
   procedure Render_Preformatted (Engine : in out Text_Renderer;
                                  Text   : in Wiki.Strings.WString;
                                  Format : in Wiki.Strings.WString) is
      pragma Unreferenced (Format);
   begin
      Engine.Close_Paragraph;
      Engine.Output.Write (Text);
      Engine.Empty_Line := False;
   end Render_Preformatted;

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Text_Renderer;
                     Doc    : in Wiki.Documents.Document;
                     Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Node_List_Access;
   begin
      case Node.Kind is
         when Wiki.Nodes.N_HEADER =>
            Engine.Close_Paragraph;
            if not Engine.Empty_Line then
               Engine.Add_Line_Break;
            end if;
            Engine.Output.Write (Node.Header);
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_LINE_BREAK =>
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_HORIZONTAL_RULE =>
            Engine.Close_Paragraph;
            Engine.Output.Write ("---------------------------------------------------------");
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_PARAGRAPH =>
            Engine.Close_Paragraph;
            Engine.Need_Paragraph := True;
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_INDENT =>
            Engine.Indent_Level := Node.Level;

         when Wiki.Nodes.N_BLOCKQUOTE =>
            Engine.Render_Blockquote (Node.Level);

         when Wiki.Nodes.N_LIST =>
            Engine.Render_List_Item (Node.Level, False);

         when Wiki.Nodes.N_NUM_LIST =>
            Engine.Render_List_Item (Node.Level, True);

         when Wiki.Nodes.N_TEXT =>
            if Engine.Empty_Line and Engine.Indent_Level /= 0 then
               for I in 1 .. Engine.Indent_Level loop
                  Engine.Output.Write (' ');
               end loop;
            end if;
            Engine.Output.Write (Node.Text);
            Engine.Empty_Line := False;

         when Wiki.Nodes.N_QUOTE =>
            Engine.Open_Paragraph;
            Engine.Output.Write (Node.Title);
            Engine.Empty_Line := False;

         when Wiki.Nodes.N_LINK =>
            Engine.Render_Link (Node.Title, Node.Link_Attr);

         when Wiki.Nodes.N_IMAGE =>
            Engine.Render_Image (Node.Title, Node.Link_Attr);

         when Wiki.Nodes.N_PREFORMAT =>
            Engine.Render_Preformatted (Node.Preformatted, "");

         when Wiki.Nodes.N_TAG_START =>
            if Node.Children /= null then
               if Node.Tag_Start = Wiki.DT_TAG then
                  Engine.Close_Paragraph;
                  Engine.Indent_Level := 0;
                  Engine.Render (Doc, Node.Children);
                  Engine.Close_Paragraph;
                  Engine.Indent_Level := 0;
               elsif Node.Tag_Start = Wiki.DD_TAG then
                  Engine.Close_Paragraph;
                  Engine.Empty_Line := True;
                  Engine.Indent_Level := 4;
                  Engine.Render (Doc, Node.Children);
                  Engine.Close_Paragraph;
                  Engine.Indent_Level := 0;
               else
                  Engine.Render (Doc, Node.Children);
                  if Node.Tag_Start = Wiki.DL_TAG then
                     Engine.Close_Paragraph;
                     Engine.New_Line;
                  end if;
               end if;
            end if;

         when others =>
            null;

      end case;
   end Render;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Engine : in out Text_Renderer;
                     Doc    : in Wiki.Documents.Document) is
      pragma Unreferenced (Doc);
   begin
      Engine.Close_Paragraph;
   end Finish;

end Wiki.Render.Text;

-----------------------------------------------------------------------
--  wiki-render-text -- Wiki Text renderer
--  Copyright (C) 2011, 2012, 2013, 2015, 2016, 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 Wiki.Helpers;
package body Wiki.Render.Text is

   --  ------------------------------
   --  Set the output writer.
   --  ------------------------------
   procedure Set_Output_Stream (Engine : in out Text_Renderer;
                                Stream : in Streams.Output_Stream_Access) is
   begin
      Engine.Output := Stream;
   end Set_Output_Stream;

   --  ------------------------------
   --  Set the no-newline mode to produce a single line text (disabled by default).
   --  ------------------------------
   procedure Set_No_Newline (Engine : in out Text_Renderer;
                             Enable : in Boolean) is
   begin
      Engine.No_Newline := Enable;
   end Set_No_Newline;

   --  ------------------------------
   --  Emit a new line.
   --  ------------------------------
   procedure New_Line (Document : in out Text_Renderer) is
   begin
      if not Document.No_Newline then
         Document.Output.Write (Wiki.Helpers.LF);
      end if;
      Document.Empty_Line := True;
   end New_Line;

   --  ------------------------------
   --  Add a line break (<br>).
   --  ------------------------------
   procedure Add_Line_Break (Document : in out Text_Renderer) is
   begin
      if not Document.No_Newline then
         Document.Output.Write (Wiki.Helpers.LF);
      end if;
      Document.Empty_Line := True;
   end Add_Line_Break;

   --  ------------------------------
   --  Render a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Render_Blockquote (Engine : in out Text_Renderer;
                                Level  : in Natural) is
   begin
      Engine.Close_Paragraph;
      for I in 1 .. Level loop
         Engine.Output.Write ("  ");
      end loop;
   end Render_Blockquote;

   --  ------------------------------
   --  Render a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Render_List_Item (Engine   : in out Text_Renderer;
                               Level    : in Positive;
                               Ordered  : in Boolean) is
      pragma Unreferenced (Level, Ordered);
   begin
      if not Engine.Empty_Line then
         Engine.Add_Line_Break;
      end if;
      Engine.Need_Paragraph := False;
      Engine.Open_Paragraph;
   end Render_List_Item;

   procedure Close_Paragraph (Document : in out Text_Renderer) is
   begin
      if Document.Has_Paragraph then
         Document.Add_Line_Break;
      end if;
      Document.Has_Paragraph := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Text_Renderer) is
   begin
      if Document.Need_Paragraph then
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Render a link.
   --  ------------------------------
   procedure Render_Link (Engine : in out Text_Renderer;
                          Title  : in Wiki.Strings.WString;
                          Attr   : in Wiki.Attributes.Attribute_List) is
      Href : constant Wiki.Strings.WString := Wiki.Attributes.Get_Attribute (Attr, "href");
   begin
      Engine.Open_Paragraph;
      if Title'Length /= 0 then
         Engine.Output.Write (Title);
      end if;
      if Title /= Href and Href'Length /= 0 then
         if Title'Length /= 0 then
            Engine.Output.Write (" (");
         end if;
         Engine.Output.Write (Href);
         if Title'Length /= 0 then
            Engine.Output.Write (")");
         end if;
      end if;
      Engine.Empty_Line := False;
   end Render_Link;

   --  ------------------------------
   --  Render an image.
   --  ------------------------------
   procedure Render_Image (Engine   : in out Text_Renderer;
                           Title    : in Wiki.Strings.WString;
                           Attr     : in Wiki.Attributes.Attribute_List) is
      Desc : constant Wiki.Strings.WString := Wiki.Attributes.Get_Attribute (Attr, "longdesc");
   begin
      Engine.Open_Paragraph;
      if Title'Length > 0 then
         Engine.Output.Write (Title);
      end if;
      if Title'Length > 0 and Desc'Length > 0 then
         Engine.Output.Write (' ');
      end if;
      if Desc'Length > 0 then
         Engine.Output.Write (Desc);
      end if;
      Engine.Empty_Line := False;
   end Render_Image;

   --  ------------------------------
   --  Render a text block that is pre-formatted.
   --  ------------------------------
   procedure Render_Preformatted (Engine : in out Text_Renderer;
                                  Text   : in Wiki.Strings.WString;
                                  Format : in Wiki.Strings.WString) is
      pragma Unreferenced (Format);
   begin
      Engine.Close_Paragraph;
      Engine.Output.Write (Text);
      Engine.Empty_Line := False;
   end Render_Preformatted;

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Text_Renderer;
                     Doc    : in Wiki.Documents.Document;
                     Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Node_List_Access;
   begin
      case Node.Kind is
         when Wiki.Nodes.N_HEADER =>
            Engine.Close_Paragraph;
            if not Engine.Empty_Line then
               Engine.Add_Line_Break;
            end if;
            Engine.Output.Write (Node.Header);
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_LINE_BREAK =>
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_HORIZONTAL_RULE =>
            Engine.Close_Paragraph;
            Engine.Output.Write ("---------------------------------------------------------");
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_PARAGRAPH =>
            Engine.Close_Paragraph;
            Engine.Need_Paragraph := True;
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_NEWLINE =>
            if not Engine.No_Newline then
               Engine.Output.Write (Wiki.Helpers.LF);
            else
               Engine.Output.Write (' ');
            end if;

         when Wiki.Nodes.N_INDENT =>
            Engine.Indent_Level := Node.Level;

         when Wiki.Nodes.N_BLOCKQUOTE =>
            Engine.Render_Blockquote (Node.Level);

         when Wiki.Nodes.N_LIST =>
            Engine.Render_List_Item (Node.Level, False);

         when Wiki.Nodes.N_NUM_LIST =>
            Engine.Render_List_Item (Node.Level, True);

         when Wiki.Nodes.N_TEXT =>
            if Engine.Empty_Line and Engine.Indent_Level /= 0 then
               for I in 1 .. Engine.Indent_Level loop
                  Engine.Output.Write (' ');
               end loop;
            end if;
            Engine.Output.Write (Node.Text);
            Engine.Empty_Line := False;

         when Wiki.Nodes.N_QUOTE =>
            Engine.Open_Paragraph;
            Engine.Output.Write (Node.Title);
            Engine.Empty_Line := False;

         when Wiki.Nodes.N_LINK =>
            Engine.Render_Link (Node.Title, Node.Link_Attr);

         when Wiki.Nodes.N_IMAGE =>
            Engine.Render_Image (Node.Title, Node.Link_Attr);

         when Wiki.Nodes.N_PREFORMAT =>
            Engine.Render_Preformatted (Node.Preformatted, "");

         when Wiki.Nodes.N_TAG_START =>
            if Node.Children /= null then
               if Node.Tag_Start = Wiki.DT_TAG then
                  Engine.Close_Paragraph;
                  Engine.Indent_Level := 0;
                  Engine.Render (Doc, Node.Children);
                  Engine.Close_Paragraph;
                  Engine.Indent_Level := 0;
               elsif Node.Tag_Start = Wiki.DD_TAG then
                  Engine.Close_Paragraph;
                  Engine.Empty_Line := True;
                  Engine.Indent_Level := 4;
                  Engine.Render (Doc, Node.Children);
                  Engine.Close_Paragraph;
                  Engine.Indent_Level := 0;
               else
                  Engine.Render (Doc, Node.Children);
                  if Node.Tag_Start = Wiki.DL_TAG then
                     Engine.Close_Paragraph;
                     Engine.New_Line;
                  end if;
               end if;
            end if;

         when others =>
            null;

      end case;
   end Render;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Engine : in out Text_Renderer;
                     Doc    : in Wiki.Documents.Document) is
      pragma Unreferenced (Doc);
   begin
      Engine.Close_Paragraph;
   end Finish;

end Wiki.Render.Text;

Add Set_No_Newline and ignore the newlines when this mode is enabled