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

with Natools.S_Expressions.Test_Tools;

package body Natools.S_Expressions.Encodings.Tests is

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Report.Section ("Encodings in S-expressions");
      Hexadecimal_Test (Report);
      Base64_Test (Report);
      Report.End_Section;
   end All_Tests;

   procedure Hexadecimal_Test (Report : in out NT.Reporter'Class) is
      All_Octets : Atom (1 .. 256);
   begin
      for I in All_Octets'Range loop
         All_Octets (I) := Octet (I - All_Octets'First);
      end loop;

      declare
         Name : constant String := "Decoding upper-case hexadecimal encoded";
      begin
         Test_Tools.Test_Atom
           (Report, Name,
            All_Octets,
            Decode_Hex (Encode_Hex (All_Octets, Upper)));
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decoding lower-case hexadecimal encoded";
      begin
         Test_Tools.Test_Atom
           (Report, Name,
            All_Octets,
            Decode_Hex (Encode_Hex (All_Octets, Lower)));
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decoding garbage-laced text";
      begin
         Test_Tools.Test_Atom
           (Report, Name,
            (16#01#, 16#23#, 16#45#, 16#67#, 16#89#,
             16#AB#, 16#CD#, 16#EF#, 16#AB#, 16#CD#, 16#EF#),
            Decode_Hex (All_Octets));
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;
   end Hexadecimal_Test;

   procedure Base64_Test (Report : in out NT.Reporter'Class) is
   begin
      declare
         Name : constant String := "Decoding encoding of all octet triplets";
         Success : Boolean := True;
         Expected : Atom (1 .. 3);
      begin
         for A in Octet loop
            Expected (1) := A;
            for B in Octet loop
               Expected (2) := B;
               for C in Octet loop
                  Expected (3) := C;

                  declare
                     Found : constant Atom
                       := Decode_Base64 (Encode_Base64 (Expected));
                  begin
                     if Expected /= Found then
                        if Success then
                           Success := False;
                           Report.Item (Name, NT.Fail);
                        end if;

                        Test_Tools.Dump_Atom (Report, Found, "Found");
                        Test_Tools.Dump_Atom (Report, Expected, "Expected");
                     end if;
                  end;
               end loop;
            end loop;
         end loop;

         if Success then
            Report.Item (Name, NT.Success);
         end if;
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decoding encoding of all octet duets";
         Success : Boolean := True;
         Expected : Atom (1 .. 2);
      begin
         for A in Octet loop
            Expected (1) := A;
            for B in Octet loop
               Expected (2) := B;

               declare
                  Found : constant Atom
                    := Decode_Base64 (Encode_Base64 (Expected));
               begin
                  if Expected /= Found then
                     if Success then
                        Success := False;
                        Report.Item (Name, NT.Fail);
                     end if;

                     Test_Tools.Dump_Atom (Report, Found, "Found");
                     Test_Tools.Dump_Atom (Report, Expected, "Expected");
                  end if;
               end;
            end loop;
         end loop;

         if Success then
            Report.Item (Name, NT.Success);
         end if;
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decoding encoding of all single octets";
         Success : Boolean := True;
         Expected : Atom (1 .. 1);
      begin
         for A in Octet loop
            Expected (1) := A;

            declare
               Found : constant Atom
                 := Decode_Base64 (Encode_Base64 (Expected));
            begin
               if Expected /= Found then
                  if Success then
                     Success := False;
                     Report.Item (Name, NT.Fail);
                  end if;

                  Test_Tools.Dump_Atom (Report, Found, "Found");
                  Test_Tools.Dump_Atom (Report, Expected, "Expected");
               end if;
            end;
         end loop;

         if Success then
            Report.Item (Name, NT.Success);
         end if;
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;
   end Base64_Test;

end Natools.S_Expressions.Encodings.Tests;

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

with Ada.Exceptions;

with Natools.S_Expressions.Test_Tools;

package body Natools.S_Expressions.Encodings.Tests is

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Hexadecimal_Test (Report);
      Base64_Test (Report);
   end All_Tests;

   procedure Hexadecimal_Test (Report : in out NT.Reporter'Class) is
      All_Octets : Atom (1 .. 256);
   begin
      for I in All_Octets'Range loop
         All_Octets (I) := Octet (I - All_Octets'First);
      end loop;

      declare
         Name : constant String := "Decoding upper-case hexadecimal encoded";
      begin
         Test_Tools.Test_Atom
           (Report, Name,
            All_Octets,
            Decode_Hex (Encode_Hex (All_Octets, Upper)));
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decoding lower-case hexadecimal encoded";
      begin
         Test_Tools.Test_Atom
           (Report, Name,
            All_Octets,
            Decode_Hex (Encode_Hex (All_Octets, Lower)));
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decoding garbage-laced text";
      begin
         Test_Tools.Test_Atom
           (Report, Name,
            (16#01#, 16#23#, 16#45#, 16#67#, 16#89#,
             16#AB#, 16#CD#, 16#EF#, 16#AB#, 16#CD#, 16#EF#),
            Decode_Hex (All_Octets));
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decoding an odd number of nibbles";
      begin
         Test_Tools.Test_Atom
           (Report, Name,
            (16#45#, 16#56#, 16#70#),
            Decode_Hex (To_Atom ("45 56 7")));
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decode_Hex with non-hex-digit";
         Result : Octet;
      begin
         Result := Decode_Hex (180);
         Report.Item (Name, NT.Fail);
         Report.Info ("No exception raised. Result: " & Octet'Image (Result));
      exception
         when Constraint_Error =>
            Report.Item (Name, NT.Success);
         when Error : others =>
            Report.Item (Name, NT.Fail);
            Report.Info ("Unexpected exception "
              & Ada.Exceptions.Exception_Name (Error)
              & " has been raised");
      end;

      declare
         Name : constant String := "Overflow in Encode_Hex";
         Result : Octet;
      begin
         Result := Encode_Hex (16, Lower);
         Report.Item (Name, NT.Fail);
         Report.Info ("No exception raised. Result: " & Octet'Image (Result));
      exception
         when Constraint_Error =>
            Report.Item (Name, NT.Success);
         when Error : others =>
            Report.Item (Name, NT.Fail);
            Report.Info ("Unexpected exception "
              & Ada.Exceptions.Exception_Name (Error)
              & " has been raised");
      end;
   end Hexadecimal_Test;

   procedure Base64_Test (Report : in out NT.Reporter'Class) is
   begin
      declare
         Name : constant String := "Decoding encoding of all octet triplets";
         Success : Boolean := True;
         Expected : Atom (1 .. 3);
      begin
         for A in Octet loop
            Expected (1) := A;
            for B in Octet loop
               Expected (2) := B;
               for C in Octet loop
                  Expected (3) := C;

                  declare
                     Found : constant Atom
                       := Decode_Base64 (Encode_Base64 (Expected));
                  begin
                     if Expected /= Found then
                        if Success then
                           Success := False;
                           Report.Item (Name, NT.Fail);
                        end if;

                        Test_Tools.Dump_Atom (Report, Found, "Found");
                        Test_Tools.Dump_Atom (Report, Expected, "Expected");
                     end if;
                  end;
               end loop;
            end loop;
         end loop;

         if Success then
            Report.Item (Name, NT.Success);
         end if;
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decoding encoding of all octet duets";
         Success : Boolean := True;
         Expected : Atom (1 .. 2);
      begin
         for A in Octet loop
            Expected (1) := A;
            for B in Octet loop
               Expected (2) := B;

               declare
                  Found : constant Atom
                    := Decode_Base64 (Encode_Base64 (Expected));
               begin
                  if Expected /= Found then
                     if Success then
                        Success := False;
                        Report.Item (Name, NT.Fail);
                     end if;

                     Test_Tools.Dump_Atom (Report, Found, "Found");
                     Test_Tools.Dump_Atom (Report, Expected, "Expected");
                  end if;
               end;
            end loop;
         end loop;

         if Success then
            Report.Item (Name, NT.Success);
         end if;
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decoding encoding of all single octets";
         Success : Boolean := True;
         Expected : Atom (1 .. 1);
      begin
         for A in Octet loop
            Expected (1) := A;

            declare
               Found : constant Atom
                 := Decode_Base64 (Encode_Base64 (Expected));
            begin
               if Expected /= Found then
                  if Success then
                     Success := False;
                     Report.Item (Name, NT.Fail);
                  end if;

                  Test_Tools.Dump_Atom (Report, Found, "Found");
                  Test_Tools.Dump_Atom (Report, Expected, "Expected");
               end if;
            end;
         end loop;

         if Success then
            Report.Item (Name, NT.Success);
         end if;
      exception
         when Error : others => Report.Report_Exception (Name, Error);
      end;

      declare
         Name : constant String := "Decode_Base64 with non-base64-digit";
         Result : Octet;
      begin
         Result := Decode_Base64 (127);
         Report.Item (Name, NT.Fail);
         Report.Info ("No exception raised. Result: " & Octet'Image (Result));
      exception
         when Constraint_Error =>
            Report.Item (Name, NT.Success);
         when Error : others =>
            Report.Item (Name, NT.Fail);
            Report.Info ("Unexpected exception "
              & Ada.Exceptions.Exception_Name (Error)
              & " has been raised");
      end;

      declare
         Name : constant String := "Overflow in Encode_Base64";
         Result : Octet;
      begin
         Result := Encode_Base64 (64);
         Report.Item (Name, NT.Fail);
         Report.Info ("No exception raised. Result: " & Octet'Image (Result));
      exception
         when Constraint_Error =>
            Report.Item (Name, NT.Success);
         when Error : others =>
            Report.Item (Name, NT.Fail);
            Report.Info ("Unexpected exception "
              & Ada.Exceptions.Exception_Name (Error)
              & " has been raised");
      end;
   end Base64_Test;

end Natools.S_Expressions.Encodings.Tests;

s_expressions-encodings-tests: add more tests to reach complete coverage


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

with Ada.Strings;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Model.Tables is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Model.Tables");

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Column_Definition;
                       Name : String) return Util.Beans.Objects.Object is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
   begin

      if Name = "type" then
         declare
            T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
         begin
            if T = null then
               return Util.Beans.Objects.Null_Object;
            end if;
            return Util.Beans.Objects.To_Object (T.all'Access, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "index" then
         return Util.Beans.Objects.To_Object (From.Number);

      elsif Name = "isUnique" then
         return Util.Beans.Objects.To_Object (From.Unique);

      elsif Name = "isNull" then
         return Util.Beans.Objects.To_Object (not From.Not_Null);

      elsif Name = "isInserted" then
         return Util.Beans.Objects.To_Object (From.Is_Inserted);

      elsif Name = "isUpdated" then
         return Util.Beans.Objects.To_Object (From.Is_Updated);

      elsif Name = "sqlType" then
         if Length (From.Sql_Type) > 0 then
            return Util.Beans.Objects.To_Object (From.Sql_Type);
         end if;
         declare
            T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
         begin
            if T = null then
               return Util.Beans.Objects.Null_Object;
            end if;
            return T.Get_Value ("name");
         end;

      elsif Name = "sqlName" then
         return Util.Beans.Objects.To_Object (From.Sql_Name);

      elsif Name = "isVersion" then
         return Util.Beans.Objects.To_Object (From.Is_Version);

      elsif Name = "isReadable" then
         return Util.Beans.Objects.To_Object (From.Is_Readable);

      elsif Name = "isPrimaryKey" then
         return Util.Beans.Objects.To_Object (From.Is_Key);

      elsif Name = "isPrimitiveType" then
         return Util.Beans.Objects.To_Object (From.Is_Basic_Type);

      elsif Name = "generator" then
         return From.Generator;

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Returns true if the column type is a basic type.
   --  ------------------------------
   function Is_Basic_Type (From : in Column_Definition) return Boolean is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
      use type Gen.Model.Mappings.Basic_Type;

      T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
      Name : constant String := To_String (From.Type_Name);
   begin
      if T /= null then
         return T.Kind /= Gen.Model.Mappings.T_BLOB;
      end if;
      return Name = "int" or Name = "String"
        or Name = "ADO.Identifier" or Name = "Timestamp"
        or Name = "Integer"
        or Name = "long" or Name = "Long" or Name = "Date" or Name = "Time";
   end Is_Basic_Type;

   --  ------------------------------
   --  Returns the column type.
   --  ------------------------------
   function Get_Type (From : in Column_Definition) return String is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
      T : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
   begin
      if T /= null then
         return To_String (T.Target);
      else
         return To_String (From.Type_Name);
      end if;
   end Get_Type;

   --  ------------------------------
   --  Returns the column type mapping.
   --  ------------------------------
   function Get_Type_Mapping (From : in Column_Definition)
                              return Gen.Model.Mappings.Mapping_Definition_Access is
      use type Mappings.Mapping_Definition_Access;

      Result : Gen.Model.Mappings.Mapping_Definition_Access := null;
      Pos    : constant Natural := Ada.Strings.Unbounded.Index (From.Type_Name, ".");
   begin
      if Pos = 0 then
         Result := Gen.Model.Mappings.Find_Type (From.Type_Name);
      end if;
      if From.Type_Name = "Gen.Tests.Tables.Test_Enum" then
         Log.Debug ("Found enum");
      end if;
      if Result = null then
         Result := From.Table.Package_Def.Find_Type (From.Type_Name);
      end if;
      return Result;
   end Get_Type_Mapping;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Column_Definition) is
      use type Mappings.Mapping_Definition_Access;
   begin
--        O.Type_Mapping := Gen.Model.Mappings.Find_Type (O.Type_Name);
--        if O.Type_Mapping = null then
--           O.Type_Mapping := O.Table.Package_Def.Find_Type (O.Type_Name);
--        end if;
      null;
   end Prepare;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Association_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      return Column_Definition (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Table_Definition) is
   begin
      O.Members_Bean := Util.Beans.Objects.To_Object (O.Members'Unchecked_Access,
                                                      Util.Beans.Objects.STATIC);
      O.Operations_Bean := Util.Beans.Objects.To_Object (O.Operations'Unchecked_Access,
                                                         Util.Beans.Objects.STATIC);
   end Initialize;

   --  ------------------------------
   --  Create a table with the given name.
   --  ------------------------------
   function Create_Table (Name : in Unbounded_String) return Table_Definition_Access is
      Table : constant Table_Definition_Access := new Table_Definition;
   begin
      Table.Name := Name;
      declare
         Pos : constant Natural := Index (Table.Name, ".", Ada.Strings.Backward);
      begin
         if Pos > 0 then
            Table.Pkg_Name := Unbounded_Slice (Table.Name, 1, Pos - 1);
            Table.Type_Name := Unbounded_Slice (Table.Name, Pos + 1, Length (Table.Name));
         else
            Table.Pkg_Name := To_Unbounded_String ("ADO");
            Table.Type_Name := Table.Name;
         end if;
         Table.Table_Name := Table.Type_Name;
      end;
      return Table;
   end Create_Table;

   --  ------------------------------
   --  Create a table column with the given name and add it to the table.
   --  ------------------------------
   procedure Add_Column (Table  : in out Table_Definition;
                         Name   : in Unbounded_String;
                         Column : out Column_Definition_Access) is
   begin
      Column := new Column_Definition;
      Column.Name     := Name;
      Column.Sql_Name := Name;
      Column.Number   := Table.Members.Get_Count;
      Column.Table    := Table'Unchecked_Access;
      Table.Members.Append (Column);
      if Name = "version" then
         Table.Version_Column := Column;
         Column.Is_Version  := True;
         Column.Is_Updated  := False;
         Column.Is_Inserted := False;

      elsif Name = "id" then
         Table.Id_Column := Column;
         Column.Is_Key := True;

      end if;
   end Add_Column;

   --  ------------------------------
   --  Create a table association with the given name and add it to the table.
   --  ------------------------------
   procedure Add_Association (Table  : in out Table_Definition;
                              Name   : in Unbounded_String;
                              Assoc  : out Association_Definition_Access) is
   begin
      Assoc := new Association_Definition;
      Assoc.Name   := Name;
      Assoc.Number := Table.Members.Get_Count;
      Assoc.Table  := Table'Unchecked_Access;
      Table.Members.Append (Assoc.all'Access);
      Table.Has_Associations := True;
   end Add_Association;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Table_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "members" or Name = "columns" then
         return From.Members_Bean;

      elsif Name = "operations" then
         return From.Operations_Bean;

      elsif Name = "id" and From.Id_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access := From.Id_Column.all'Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "version" and From.Version_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access
              := From.Version_Column.all'Unchecked_Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "hasAssociations" then
         return Util.Beans.Objects.To_Object (From.Has_Associations);

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "table" then
         return Util.Beans.Objects.To_Object (From.Table_Name);

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Table_Definition) is
      Iter : Column_List.Cursor := O.Members.First;
   begin
      while Column_List.Has_Element (Iter) loop
         Column_List.Element (Iter).Prepare;
         Column_List.Next (Iter);
      end loop;
   end Prepare;

   --  ------------------------------
   --  Set the table name and determines the package name.
   --  ------------------------------
   procedure Set_Table_Name (Table : in out Table_Definition;
                             Name  : in String) is
      Pos : constant Natural := Util.Strings.Rindex (Name, '.');
   begin
      Table.Name := To_Unbounded_String (Name);
      if Pos > 0 then
         Table.Pkg_Name := To_Unbounded_String (Name (Name'First .. Pos - 1));
         Table.Type_Name := To_Unbounded_String (Name (Pos + 1 .. Name'Last));
      else
         Table.Pkg_Name := To_Unbounded_String ("ADO");
         Table.Type_Name := Table.Name;
      end if;
   end Set_Table_Name;

end Gen.Model.Tables;

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

with Ada.Strings;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Model.Tables is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Model.Tables");

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Column_Definition;
                       Name : String) return Util.Beans.Objects.Object is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
   begin

      if Name = "type" then
         declare
            T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
         begin
            if T = null then
               return Util.Beans.Objects.Null_Object;
            end if;
            return Util.Beans.Objects.To_Object (T.all'Access, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "index" then
         return Util.Beans.Objects.To_Object (From.Number);

      elsif Name = "isUnique" then
         return Util.Beans.Objects.To_Object (From.Unique);

      elsif Name = "isNull" then
         return Util.Beans.Objects.To_Object (not From.Not_Null);

      elsif Name = "isInserted" then
         return Util.Beans.Objects.To_Object (From.Is_Inserted);

      elsif Name = "isUpdated" then
         return Util.Beans.Objects.To_Object (From.Is_Updated);

      elsif Name = "sqlType" then
         if Length (From.Sql_Type) > 0 then
            return Util.Beans.Objects.To_Object (From.Sql_Type);
         end if;
         declare
            T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
         begin
            if T = null then
               return Util.Beans.Objects.Null_Object;
            end if;
            return T.Get_Value ("name");
         end;

      elsif Name = "sqlName" then
         return Util.Beans.Objects.To_Object (From.Sql_Name);

      elsif Name = "isVersion" then
         return Util.Beans.Objects.To_Object (From.Is_Version);

      elsif Name = "isReadable" then
         return Util.Beans.Objects.To_Object (From.Is_Readable);

      elsif Name = "isPrimaryKey" then
         return Util.Beans.Objects.To_Object (From.Is_Key);

      elsif Name = "isPrimitiveType" then
         return Util.Beans.Objects.To_Object (From.Is_Basic_Type);

      elsif Name = "generator" then
         return From.Generator;

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Returns true if the column type is a basic type.
   --  ------------------------------
   function Is_Basic_Type (From : in Column_Definition) return Boolean is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
      use type Gen.Model.Mappings.Basic_Type;

      T    : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
      Name : constant String := To_String (From.Type_Name);
   begin
      if T /= null then
         return T.Kind /= Gen.Model.Mappings.T_BLOB;
      end if;
      return Name = "int" or Name = "String"
        or Name = "ADO.Identifier" or Name = "Timestamp"
        or Name = "Integer"
        or Name = "long" or Name = "Long" or Name = "Date" or Name = "Time";
   end Is_Basic_Type;

   --  ------------------------------
   --  Returns the column type.
   --  ------------------------------
   function Get_Type (From : in Column_Definition) return String is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
      T : constant Gen.Model.Mappings.Mapping_Definition_Access := From.Get_Type_Mapping;
   begin
      if T /= null then
         return To_String (T.Target);
      else
         return To_String (From.Type_Name);
      end if;
   end Get_Type;

   --  ------------------------------
   --  Returns the column type mapping.
   --  ------------------------------
   function Get_Type_Mapping (From : in Column_Definition)
                              return Gen.Model.Mappings.Mapping_Definition_Access is
      use type Mappings.Mapping_Definition_Access;

      Result : Gen.Model.Mappings.Mapping_Definition_Access := null;
      Pos    : constant Natural := Ada.Strings.Unbounded.Index (From.Type_Name, ".");
   begin
      if Pos = 0 then
         Result := Gen.Model.Mappings.Find_Type (From.Type_Name);
      end if;
      if From.Type_Name = "Gen.Tests.Tables.Test_Enum" then
         Log.Debug ("Found enum");
      end if;
      if Result = null then
         Result := From.Table.Package_Def.Find_Type (From.Type_Name);
      end if;
      return Result;
   end Get_Type_Mapping;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Column_Definition) is
      use type Mappings.Mapping_Definition_Access;
   begin
--        O.Type_Mapping := Gen.Model.Mappings.Find_Type (O.Type_Name);
--        if O.Type_Mapping = null then
--           O.Type_Mapping := O.Table.Package_Def.Find_Type (O.Type_Name);
--        end if;
      null;
   end Prepare;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Association_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      return Column_Definition (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Table_Definition) is
   begin
      O.Members_Bean := Util.Beans.Objects.To_Object (O.Members'Unchecked_Access,
                                                      Util.Beans.Objects.STATIC);
      O.Operations_Bean := Util.Beans.Objects.To_Object (O.Operations'Unchecked_Access,
                                                         Util.Beans.Objects.STATIC);
   end Initialize;

   --  ------------------------------
   --  Create a table with the given name.
   --  ------------------------------
   function Create_Table (Name : in Unbounded_String) return Table_Definition_Access is
      Table : constant Table_Definition_Access := new Table_Definition;
   begin
      Table.Name := Name;
      declare
         Pos : constant Natural := Index (Table.Name, ".", Ada.Strings.Backward);
      begin
         if Pos > 0 then
            Table.Pkg_Name := Unbounded_Slice (Table.Name, 1, Pos - 1);
            Table.Type_Name := Unbounded_Slice (Table.Name, Pos + 1, Length (Table.Name));
         else
            Table.Pkg_Name := To_Unbounded_String ("ADO");
            Table.Type_Name := Table.Name;
         end if;
         Table.Table_Name := Table.Type_Name;
      end;
      return Table;
   end Create_Table;

   --  ------------------------------
   --  Create a table column with the given name and add it to the table.
   --  ------------------------------
   procedure Add_Column (Table  : in out Table_Definition;
                         Name   : in Unbounded_String;
                         Column : out Column_Definition_Access) is
   begin
      Column := new Column_Definition;
      Column.Name     := Name;
      Column.Sql_Name := Name;
      Column.Number   := Table.Members.Get_Count;
      Column.Table    := Table'Unchecked_Access;
      Table.Members.Append (Column);
      if Name = "version" then
         Table.Version_Column := Column;
         Column.Is_Version  := True;
         Column.Is_Updated  := False;
         Column.Is_Inserted := False;

      elsif Name = "id" then
         Table.Id_Column := Column;
         Column.Is_Key := True;

      end if;
   end Add_Column;

   --  ------------------------------
   --  Create a table association with the given name and add it to the table.
   --  ------------------------------
   procedure Add_Association (Table  : in out Table_Definition;
                              Name   : in Unbounded_String;
                              Assoc  : out Association_Definition_Access) is
   begin
      Assoc := new Association_Definition;
      Assoc.Name   := Name;
      Assoc.Number := Table.Members.Get_Count;
      Assoc.Table  := Table'Unchecked_Access;
      Assoc.Sql_Name := Name;
      Table.Members.Append (Assoc.all'Access);
      Table.Has_Associations := True;
   end Add_Association;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Table_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "members" or Name = "columns" then
         return From.Members_Bean;

      elsif Name = "operations" then
         return From.Operations_Bean;

      elsif Name = "id" and From.Id_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access := From.Id_Column.all'Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "version" and From.Version_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access
              := From.Version_Column.all'Unchecked_Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "hasAssociations" then
         return Util.Beans.Objects.To_Object (From.Has_Associations);

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "table" then
         return Util.Beans.Objects.To_Object (From.Table_Name);

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Table_Definition) is
      Iter : Column_List.Cursor := O.Members.First;
   begin
      while Column_List.Has_Element (Iter) loop
         Column_List.Element (Iter).Prepare;
         Column_List.Next (Iter);
      end loop;
   end Prepare;

   --  ------------------------------
   --  Set the table name and determines the package name.
   --  ------------------------------
   procedure Set_Table_Name (Table : in out Table_Definition;
                             Name  : in String) is
      Pos : constant Natural := Util.Strings.Rindex (Name, '.');
   begin
      Table.Name := To_Unbounded_String (Name);
      if Pos > 0 then
         Table.Pkg_Name := To_Unbounded_String (Name (Name'First .. Pos - 1));
         Table.Type_Name := To_Unbounded_String (Name (Pos + 1 .. Name'Last));
      else
         Table.Pkg_Name := To_Unbounded_String ("ADO");
         Table.Type_Name := Table.Name;
      end if;
   end Set_Table_Name;

end Gen.Model.Tables;

Set the association sql name from the association name


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

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Document : in out Text_Renderer;
                       Title    : in Wiki.Strings.WString;
                       Attr     : in Wiki.Attributes.Attribute_List_Type) is
   begin
      Document.Open_Paragraph;
      if Title'Length /= 0 then
         Document.Output.Write (Title);
      end if;
      Document.Empty_Line := False;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Document    : in out Text_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);
   begin
      Document.Open_Paragraph;
--        if Length (Alt) > 0 then
--           Document.Output.Write (Alt);
--        end if;
--        if Length (Description) > 0 then
--           Document.Output.Write (Description);
--        end if;
--        Document.Output.Write (Link);
      Document.Empty_Line := False;
   end Add_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.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Html_Tag_Type;
      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.Add_Link (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.Nodes.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.Nodes.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.Nodes.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 (Document : in out Text_Renderer) is
   begin
      Document.Close_Paragraph;
   end Finish;

end Wiki.Render.Text;

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

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Document : in out Text_Renderer;
                       Title    : in Wiki.Strings.WString;
                       Attr     : in Wiki.Attributes.Attribute_List_Type) is
   begin
      Document.Open_Paragraph;
      if Title'Length /= 0 then
         Document.Output.Write (Title);
      end if;
      Document.Empty_Line := False;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Document    : in out Text_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);
   begin
      Document.Open_Paragraph;
--        if Length (Alt) > 0 then
--           Document.Output.Write (Alt);
--        end if;
--        if Length (Description) > 0 then
--           Document.Output.Write (Description);
--        end if;
--        Document.Output.Write (Link);
      Document.Empty_Line := False;
   end Add_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.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Html_Tag;
      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.Add_Link (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 (Document : in out Text_Renderer) is
   begin
      Document.Close_Paragraph;
   end Finish;

end Wiki.Render.Text;

Move the Html_Tag type from Wiki.Nodes to Wiki package


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

   TITLE_ATTR         : aliased constant String := "title";
   STYLE_ATTR         : aliased constant String := "style";
   STYLE_CLASS_ATTR   : aliased constant String := "styleClass";
   DIR_ATTR           : aliased constant String := "dir";
   LANG_ATTR          : aliased constant String := "lang";

   ACCESS_KEY_ATTR    : aliased constant String := "accesskey";
   ON_BLUR_ATTR       : aliased constant String := "onblur";
   ON_CLICK_ATTR      : aliased constant String := "onclick";
   ON_DBLCLICK_ATTR   : aliased constant String := "ondblclick";
   ON_FOCUS_ATTR      : aliased constant String := "onfocus";
   ON_KEYDOWN_ATTR    : aliased constant String := "onkeydown";
   ON_KEYUP_ATTR      : aliased constant String := "onkeyup";
   ON_MOUSE_DOWN_ATTR : aliased constant String := "onmousedown";
   ON_MOUSE_MOVE_ATTR : aliased constant String := "onmousemove";
   ON_MOUSE_OUT_ATTR  : aliased constant String := "onmouseout";
   ON_MOUSE_OVER_ATTR : aliased constant String := "onmouseover";
   ON_MOUSE_UP_ATTR   : aliased constant String := "onmouseup";
   ON_CHANGE_ATTR     : aliased constant String := "onchange";

   ON_RESET_ATTR      : aliased constant String := "onreset";
   ON_SUBMIT_ATTR     : aliased constant String := "onsubmit";
   ENCTYPE_ATTR       : aliased constant String := "enctype";

   ON_LOAD_ATTR       : aliased constant String := "onload";
   ON_UNLOAD_ATTR     : aliased constant String := "onunload";

   TABINDEX_ATTR      : aliased constant String := "tabindex";

   AUTOCOMPLETE_ATTR  : aliased constant String := "autocomplete";
   SIZE_ATTR          : aliased constant String := "size";
   MAXLENGTH_ATTR     : aliased constant String := "maxlength";
   ALT_ATTR           : aliased constant String := "alt";
   DISABLED_ATTR      : aliased constant String := "disabled";
   READONLY_ATTR      : aliased constant String := "readonly";
   PLACEHOLDER_ATTR   : aliased constant String := "placeholder";
   PATTERN_ATTR       : aliased constant String := "pattern";
   AUTOFOCUS_ATTR     : aliased constant String := "autofocus";
   LIST_ATTR          : aliased constant String := "list";
   FORMENCTYPE_ATTR   : aliased constant String := "formenctype";
   FORMMETHOD_ATTR    : aliased constant String := "formmethod";
   FORMACTION_ATTR    : aliased constant String := "formaction";
   FORMTARGET_ATTR    : aliased constant String := "formtarget";

   ACCEPT_ATTR        : aliased constant String := "accept";

   ROWS_ATTR          : aliased constant String := "rows";
   COLS_ATTR          : aliased constant String := "cols";

   CHARSET_ATTR       : aliased constant String := "charset";
   SHAPE_ATTR         : aliased constant String := "shape";
   REV_ATTR           : aliased constant String := "rev";
   COORDS_ATTR        : aliased constant String := "coords";
   TARGET_ATTR        : aliased constant String := "target";
   HREFLANG_ATTR      : aliased constant String := "hreflang";

   --  ------------------------------
   --  Add in the names set, the basic text attributes that can be set
   --  on HTML elements (dir, lang, style, title).
   --  ------------------------------
   procedure Set_Text_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (STYLE_CLASS_ATTR'Access);
      Names.Insert (TITLE_ATTR'Access);
      Names.Insert (DIR_ATTR'Access);
      Names.Insert (LANG_ATTR'Access);
      Names.Insert (STYLE_ATTR'Access);
   end Set_Text_Attributes;

   --  ------------------------------
   --  Add in the names set, the onXXX attributes that can be set
   --  on HTML elements (accesskey, tabindex, onXXX).
   --  ------------------------------
   procedure Set_Interactive_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (ACCESS_KEY_ATTR'Access);
      Names.Insert (TABINDEX_ATTR'Access);
      Names.Insert (ON_BLUR_ATTR'Access);
      Names.Insert (ON_MOUSE_UP_ATTR'Access);
      Names.Insert (ON_MOUSE_OVER_ATTR'Access);
      Names.Insert (ON_MOUSE_OUT_ATTR'Access);
      Names.Insert (ON_MOUSE_MOVE_ATTR'Access);
      Names.Insert (ON_MOUSE_DOWN_ATTR'Access);
      Names.Insert (ON_KEYUP_ATTR'Access);
      Names.Insert (ON_KEYDOWN_ATTR'Access);
      Names.Insert (ON_FOCUS_ATTR'Access);
      Names.Insert (ON_DBLCLICK_ATTR'Access);
      Names.Insert (ON_CLICK_ATTR'Access);
      Names.Insert (ON_CHANGE_ATTR'Access);
   end Set_Interactive_Attributes;

   --  ------------------------------
   --  Add in the names set, the size attributes that can be set
   --  on HTML elements.
   --  ------------------------------
   procedure Set_Input_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (SIZE_ATTR'Access);
      Names.Insert (AUTOCOMPLETE_ATTR'Access);
      Names.Insert (MAXLENGTH_ATTR'Access);
      Names.Insert (ALT_ATTR'Access);
      Names.Insert (DISABLED_ATTR'Access);
      Names.Insert (READONLY_ATTR'Access);
      Names.Insert (PLACEHOLDER_ATTR'Access);
      Names.Insert (PATTERN_ATTR'Access);
      Names.Insert (AUTOFOCUS_ATTR'Access);
      Names.Insert (LIST_ATTR'Access);
      Names.Insert (FORMENCTYPE_ATTR'Access);
      Names.Insert (FORMMETHOD_ATTR'Access);
      Names.Insert (FORMACTION_ATTR'Access);
      Names.Insert (FORMTARGET_ATTR'Access);
   end Set_Input_Attributes;

   --  ------------------------------
   --  Add in the names set, the size attributes that can be set
   --  on <textarea> elements.
   --  ------------------------------
   procedure Set_Textarea_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (ROWS_ATTR'Access);
      Names.Insert (COLS_ATTR'Access);
   end Set_Textarea_Attributes;

   --  ------------------------------
   --  Add in the names set, the online and onunload attributes that can be set
   --  on  elements.
   --  ------------------------------
   procedure Set_Body_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (ON_LOAD_ATTR'Access);
      Names.Insert (ON_UNLOAD_ATTR'Access);
   end Set_Body_Attributes;

   --  ------------------------------
   --  Add in the names set, the dir, lang attributes that can be set
   --  on  elements.
   --  ------------------------------
   procedure Set_Head_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (DIR_ATTR'Access);
      Names.Insert (LANG_ATTR'Access);
   end Set_Head_Attributes;

   --------------------
   --  Add in the names set, the onreset and onsubmit attributes that can be set
   --  on <form> elements.
   --  ------------------------------
   procedure Set_Form_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (ON_RESET_ATTR'Access);
      Names.Insert (ON_SUBMIT_ATTR'Access);
      Names.Insert (ENCTYPE_ATTR'Access);
   end Set_Form_Attributes;

   --------------------
   --  Add in the names set, the attributes which are specific to a link.
   --  ------------------------------
   procedure Set_Link_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (CHARSET_ATTR'Access);
      Names.Insert (SHAPE_ATTR'Access);
      Names.Insert (REV_ATTR'Access);
      Names.Insert (COORDS_ATTR'Access);
      Names.Insert (TARGET_ATTR'Access);
      Names.Insert (HREFLANG_ATTR'Access);
   end Set_Link_Attributes;

   --  ------------------------------
   --  Add in the names set, the attributes which are specific to an input file.
   --  ------------------------------
   procedure Set_File_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (ACCEPT_ATTR'Access);
   end Set_File_Attributes;

end ASF.Utils;

-----------------------------------------------------------------------
--  html -- ASF HTML Components
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 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.
-----------------------------------------------------------------------
package body ASF.Utils is

   TITLE_ATTR         : aliased constant String := "title";
   STYLE_ATTR         : aliased constant String := "style";
   STYLE_CLASS_ATTR   : aliased constant String := "styleClass";
   DIR_ATTR           : aliased constant String := "dir";
   LANG_ATTR          : aliased constant String := "lang";

   ACCESS_KEY_ATTR    : aliased constant String := "accesskey";
   ON_BLUR_ATTR       : aliased constant String := "onblur";
   ON_CLICK_ATTR      : aliased constant String := "onclick";
   ON_DBLCLICK_ATTR   : aliased constant String := "ondblclick";
   ON_FOCUS_ATTR      : aliased constant String := "onfocus";
   ON_KEYDOWN_ATTR    : aliased constant String := "onkeydown";
   ON_KEYUP_ATTR      : aliased constant String := "onkeyup";
   ON_MOUSE_DOWN_ATTR : aliased constant String := "onmousedown";
   ON_MOUSE_MOVE_ATTR : aliased constant String := "onmousemove";
   ON_MOUSE_OUT_ATTR  : aliased constant String := "onmouseout";
   ON_MOUSE_OVER_ATTR : aliased constant String := "onmouseover";
   ON_MOUSE_UP_ATTR   : aliased constant String := "onmouseup";
   ON_CHANGE_ATTR     : aliased constant String := "onchange";

   ON_RESET_ATTR      : aliased constant String := "onreset";
   ON_SUBMIT_ATTR     : aliased constant String := "onsubmit";
   ENCTYPE_ATTR       : aliased constant String := "enctype";

   ON_LOAD_ATTR       : aliased constant String := "onload";
   ON_UNLOAD_ATTR     : aliased constant String := "onunload";

   TABINDEX_ATTR      : aliased constant String := "tabindex";

   AUTOCOMPLETE_ATTR  : aliased constant String := "autocomplete";
   SIZE_ATTR          : aliased constant String := "size";
   MAXLENGTH_ATTR     : aliased constant String := "maxlength";
   ALT_ATTR           : aliased constant String := "alt";
   DISABLED_ATTR      : aliased constant String := "disabled";
   DIRNAME_ATTR       : aliased constant String := "dirname";
   READONLY_ATTR      : aliased constant String := "readonly";
   PLACEHOLDER_ATTR   : aliased constant String := "placeholder";
   PATTERN_ATTR       : aliased constant String := "pattern";
   AUTOFOCUS_ATTR     : aliased constant String := "autofocus";
   LIST_ATTR          : aliased constant String := "list";
   FORMENCTYPE_ATTR   : aliased constant String := "formenctype";
   FORMMETHOD_ATTR    : aliased constant String := "formmethod";
   FORMACTION_ATTR    : aliased constant String := "formaction";
   FORMTARGET_ATTR    : aliased constant String := "formtarget";
   WRAP_ATTR          : aliased constant String := "wrap";

   ACCEPT_ATTR        : aliased constant String := "accept";

   ROWS_ATTR          : aliased constant String := "rows";
   COLS_ATTR          : aliased constant String := "cols";

   CHARSET_ATTR       : aliased constant String := "charset";
   SHAPE_ATTR         : aliased constant String := "shape";
   REV_ATTR           : aliased constant String := "rev";
   COORDS_ATTR        : aliased constant String := "coords";
   TARGET_ATTR        : aliased constant String := "target";
   HREFLANG_ATTR      : aliased constant String := "hreflang";

   --  ------------------------------
   --  Add in the names set, the basic text attributes that can be set
   --  on HTML elements (dir, lang, style, title).
   --  ------------------------------
   procedure Set_Text_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (STYLE_CLASS_ATTR'Access);
      Names.Insert (TITLE_ATTR'Access);
      Names.Insert (DIR_ATTR'Access);
      Names.Insert (LANG_ATTR'Access);
      Names.Insert (STYLE_ATTR'Access);
   end Set_Text_Attributes;

   --  ------------------------------
   --  Add in the names set, the onXXX attributes that can be set
   --  on HTML elements (accesskey, tabindex, onXXX).
   --  ------------------------------
   procedure Set_Interactive_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (ACCESS_KEY_ATTR'Access);
      Names.Insert (TABINDEX_ATTR'Access);
      Names.Insert (ON_BLUR_ATTR'Access);
      Names.Insert (ON_MOUSE_UP_ATTR'Access);
      Names.Insert (ON_MOUSE_OVER_ATTR'Access);
      Names.Insert (ON_MOUSE_OUT_ATTR'Access);
      Names.Insert (ON_MOUSE_MOVE_ATTR'Access);
      Names.Insert (ON_MOUSE_DOWN_ATTR'Access);
      Names.Insert (ON_KEYUP_ATTR'Access);
      Names.Insert (ON_KEYDOWN_ATTR'Access);
      Names.Insert (ON_FOCUS_ATTR'Access);
      Names.Insert (ON_DBLCLICK_ATTR'Access);
      Names.Insert (ON_CLICK_ATTR'Access);
      Names.Insert (ON_CHANGE_ATTR'Access);
   end Set_Interactive_Attributes;

   --  ------------------------------
   --  Add in the names set, the size attributes that can be set
   --  on HTML elements.
   --  ------------------------------
   procedure Set_Input_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (SIZE_ATTR'Access);
      Names.Insert (AUTOCOMPLETE_ATTR'Access);
      Names.Insert (MAXLENGTH_ATTR'Access);
      Names.Insert (ALT_ATTR'Access);
      Names.Insert (DISABLED_ATTR'Access);
      Names.Insert (READONLY_ATTR'Access);
      Names.Insert (PLACEHOLDER_ATTR'Access);
      Names.Insert (PATTERN_ATTR'Access);
      Names.Insert (AUTOFOCUS_ATTR'Access);
      Names.Insert (LIST_ATTR'Access);
      Names.Insert (FORMENCTYPE_ATTR'Access);
      Names.Insert (FORMMETHOD_ATTR'Access);
      Names.Insert (FORMACTION_ATTR'Access);
      Names.Insert (FORMTARGET_ATTR'Access);
   end Set_Input_Attributes;

   --  ------------------------------
   --  Add in the names set, the size attributes that can be set
   --  on <textarea> elements.
   --  ------------------------------
   procedure Set_Textarea_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (AUTOFOCUS_ATTR'Access);
      Names.Insert (COLS_ATTR'Access);
      Names.Insert (DIRNAME_ATTR'Access);
      Names.Insert (DISABLED_ATTR'Access);
      Names.Insert (MAXLENGTH_ATTR'Access);
      Names.Insert (PLACEHOLDER_ATTR'Access);
      Names.Insert (READONLY_ATTR'Access);
      Names.Insert (ROWS_ATTR'Access);
      Names.Insert (WRAP_ATTR'Access);
   end Set_Textarea_Attributes;

   --  ------------------------------
   --  Add in the names set, the online and onunload attributes that can be set
   --  on  elements.
   --  ------------------------------
   procedure Set_Body_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (ON_LOAD_ATTR'Access);
      Names.Insert (ON_UNLOAD_ATTR'Access);
   end Set_Body_Attributes;

   --  ------------------------------
   --  Add in the names set, the dir, lang attributes that can be set
   --  on  elements.
   --  ------------------------------
   procedure Set_Head_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (DIR_ATTR'Access);
      Names.Insert (LANG_ATTR'Access);
   end Set_Head_Attributes;

   --------------------
   --  Add in the names set, the onreset and onsubmit attributes that can be set
   --  on <form> elements.
   --  ------------------------------
   procedure Set_Form_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (ON_RESET_ATTR'Access);
      Names.Insert (ON_SUBMIT_ATTR'Access);
      Names.Insert (ENCTYPE_ATTR'Access);
   end Set_Form_Attributes;

   --------------------
   --  Add in the names set, the attributes which are specific to a link.
   --  ------------------------------
   procedure Set_Link_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (CHARSET_ATTR'Access);
      Names.Insert (SHAPE_ATTR'Access);
      Names.Insert (REV_ATTR'Access);
      Names.Insert (COORDS_ATTR'Access);
      Names.Insert (TARGET_ATTR'Access);
      Names.Insert (HREFLANG_ATTR'Access);
   end Set_Link_Attributes;

   --  ------------------------------
   --  Add in the names set, the attributes which are specific to an input file.
   --  ------------------------------
   procedure Set_File_Attributes (Names : in out Util.Strings.String_Set.Set) is
   begin
      Names.Insert (ACCEPT_ATTR'Access);
   end Set_File_Attributes;

end ASF.Utils;

Fix Set_Textarea_Attributes to take into account more attributes for the HTML textarea


-- Simple Lumen demo/test program, using earliest incomplete library.

with Lumen.Window;
with Lumen.Events.Animate;
with GL;
with GLU;

procedure Spinner is

   ---------------------------------------------------------------------------

   -- Rotation wraps around at this point, in degrees
   Max_Rotation : constant := 359;

   -- Traditional cinema framrate, in frames per second
   Framerate    : constant := 24;

   ---------------------------------------------------------------------------

   Win      : Lumen.Window.Handle;
   Event    : Lumen.Events.Event_Data;
   Wide     : Natural := 400;
   High     : Natural := 400;
   Rotation : Natural := 0;

   ---------------------------------------------------------------------------

   Program_Exit : exception;

   ---------------------------------------------------------------------------

   -- Set or reset the window view parameters
   procedure Set_View (W, H : in Natural) is

      use GL;
      use GLU;

      Aspect : GLdouble;

   begin  -- Set_View

      -- Viewport dimensions
      glViewport (0, 0, GLsizei (W), GLsizei (H));

      -- Set up the projection matrix based on the window's shape--wider than
      -- high, or higher than wide
      glMatrixMode (GL_PROJECTION);
      glLoadIdentity;

      if W <= H then
         Aspect := GLdouble (H) / GLdouble (W);
         gluOrtho2D (-2.0, 2.0, -2.0 * Aspect, 2.0 * Aspect);
      else
         Aspect := GLdouble (W) / GLdouble (H);
         gluOrtho2D (-2.0 * Aspect, 2.0 * Aspect, -2.0, 2.0);
      end if;
   end Set_View;

   ---------------------------------------------------------------------------

   -- Draw our scene
   procedure Draw is

      use GL;

   begin  -- Draw

      -- Set a black background
      glClearColor (0.0, 0.0, 0.0, 0.0);
      glClear (GL_COLOR_BUFFER_BIT);

      -- Draw a hideous orange square
      glColor3f (1.0, 1.0, 0.5);

      glBegin (GL_POLYGON);
      begin
         glVertex2f (-1.0, -1.0);
         glVertex2f (-1.0,  1.0);
         glVertex2f ( 1.0,  1.0);
         glVertex2f ( 1.0, -1.0);
      end;
      glEnd;

      -- Rotate the square around the Z axis by the current amount
      glMatrixMode (GL_MODELVIEW);
      glLoadIdentity;
      glRotated (GLdouble (Rotation), 0.0, 0.0, -1.0);

      glFlush;

      -- Now show it
      Lumen.Window.Swap (Win);

   end Draw;

   ---------------------------------------------------------------------------

   -- Simple event handler routine for keypresses and close-window events
   procedure Quit_Handler (Event : in Lumen.Events.Event_Data) is
   begin  -- Quit_Handler
      raise Program_Exit;
   end Quit_Handler;

   ---------------------------------------------------------------------------

   -- Simple event handler routine for Exposed events
   procedure Expose_Handler (Event : in Lumen.Events.Event_Data) is
   begin  -- Expose_Handler
      Draw;
   end Expose_Handler;

   ---------------------------------------------------------------------------

   -- Simple event handler routine for Resized events
   procedure Resize_Handler (Event : in Lumen.Events.Event_Data) is
   begin  -- Resize_Handler
      Wide := Event.Resize_Data.Width;
      High := Event.Resize_Data.Height;
      Set_View (Wide, High);
      Draw;
   end Resize_Handler;

   ---------------------------------------------------------------------------

   -- Our draw-a-frame routine, should get called FPS times a second
   procedure New_Frame is
   begin  -- New_Frame
      if Rotation >= Max_Rotation then
         Rotation := 0;
      else
         Rotation := Rotation + 1;
      end if;

      Draw;
   end New_Frame;

   ---------------------------------------------------------------------------

begin  -- Spinner

   -- Create Lumen window, accepting most defaults; turn double buffering off
   -- for simplicity
   Win := Lumen.Window.Create (Name   => "Spinning Square Demo",
                               Width  => Wide,
                               Height => High,
                               Events => (Lumen.Window.Want_Key_Press => True,
                                          Lumen.Window.Want_Exposure  => True,
                                          others => False));

   -- Set up the viewport and scene parameters
   Set_View (Wide, High);

   -- Enter the event loop
   declare
      use Lumen.Events;
   begin
      Animate.Select_Events (Win   => Win,
                             Calls => (Key_Press    => Quit_Handler'Unrestricted_Access,
                                       Exposed      => Expose_Handler'Unrestricted_Access,
                                       Resized      => Resize_Handler'Unrestricted_Access,
                                       Close_Window => Quit_Handler'Unrestricted_Access,
                                       others       => No_Callback),
                             FPS   => Framerate,
                             Frame => New_Frame'Unrestricted_Access);
   end;

exception
   when Program_Exit =>
      null;  -- just exit this block, which terminates the app

end Spinner;

-- Simple Lumen demo/test program, using earliest incomplete library.

with Lumen.Window;
with Lumen.Events.Animate;
with GL;
with GLU;

procedure Spinner is

   ---------------------------------------------------------------------------

   -- Rotation wraps around at this point, in degrees
   Max_Rotation : constant := 359;

   -- Traditional cinema framrate, in frames per second
   Framerate    : constant := 24;

   ---------------------------------------------------------------------------

   Win      : Lumen.Window.Handle;
   Event    : Lumen.Events.Event_Data;
   Wide     : Natural := 400;
   High     : Natural := 400;
   Rotation : Natural := 0;

   ---------------------------------------------------------------------------

   Program_Exit : exception;

   ---------------------------------------------------------------------------

   -- Set or reset the window view parameters
   procedure Set_View (W, H : in Natural) is

      use GL;
      use GLU;

      Aspect : GLdouble;

   begin  -- Set_View

      -- Viewport dimensions
      glViewport (0, 0, GLsizei (W), GLsizei (H));

      -- Set up the projection matrix based on the window's shape--wider than
      -- high, or higher than wide
      glMatrixMode (GL_PROJECTION);
      glLoadIdentity;

      if W <= H then
         Aspect := GLdouble (H) / GLdouble (W);
         gluOrtho2D (-2.0, 2.0, -2.0 * Aspect, 2.0 * Aspect);
      else
         Aspect := GLdouble (W) / GLdouble (H);
         gluOrtho2D (-2.0 * Aspect, 2.0 * Aspect, -2.0, 2.0);
      end if;
   end Set_View;

   ---------------------------------------------------------------------------

   -- Draw our scene
   procedure Draw is

      use GL;

   begin  -- Draw

      -- Set a black background
      glClearColor (0.0, 0.0, 0.0, 0.0);
      glClear (GL_COLOR_BUFFER_BIT);

      glBegin (GL_POLYGON);
      begin
         glColor3f (1.0, 0.0, 0.0);
         glVertex2f (-1.0, -1.0);
         glColor3f (1.0, 0.0, 0.0);
         glVertex2f (-1.0,  1.0);
         glColor3f (1.0, 1.0, 0.0);
         glVertex2f ( 1.0,  1.0);
         glColor3f (1.0, 1.0, 0.0);
         glVertex2f ( 1.0, -1.0);
      end;
      glEnd;

      -- Rotate the square around the Z axis by the current amount
      glMatrixMode (GL_MODELVIEW);
      glLoadIdentity;
      glRotated (GLdouble (Rotation), 0.0, 0.0, -1.0);

      glFlush;

      -- Now show it
      Lumen.Window.Swap (Win);

   end Draw;

   ---------------------------------------------------------------------------

   -- Simple event handler routine for keypresses and close-window events
   procedure Quit_Handler (Event : in Lumen.Events.Event_Data) is
   begin  -- Quit_Handler
      raise Program_Exit;
   end Quit_Handler;

   ---------------------------------------------------------------------------

   -- Simple event handler routine for Exposed events
   procedure Expose_Handler (Event : in Lumen.Events.Event_Data) is
   begin  -- Expose_Handler
      Draw;
   end Expose_Handler;

   ---------------------------------------------------------------------------

   -- Simple event handler routine for Resized events
   procedure Resize_Handler (Event : in Lumen.Events.Event_Data) is
   begin  -- Resize_Handler
      Wide := Event.Resize_Data.Width;
      High := Event.Resize_Data.Height;
      Set_View (Wide, High);
      Draw;
   end Resize_Handler;

   ---------------------------------------------------------------------------

   -- Our draw-a-frame routine, should get called FPS times a second
   procedure New_Frame is
   begin  -- New_Frame
      if Rotation >= Max_Rotation then
         Rotation := 0;
      else
         Rotation := Rotation + 1;
      end if;

      Draw;
   end New_Frame;

   ---------------------------------------------------------------------------

begin  -- Spinner

   -- Create Lumen window, accepting most defaults; turn double buffering off
   -- for simplicity
   Win := Lumen.Window.Create (Name   => "Spinning Square Demo",
                               Width  => Wide,
                               Height => High,
                               Events => (Lumen.Window.Want_Key_Press => True,
                                          Lumen.Window.Want_Exposure  => True,
                                          others => False));

   -- Set up the viewport and scene parameters
   Set_View (Wide, High);

   -- Enter the event loop
   declare
      use Lumen.Events;
   begin
      Animate.Select_Events (Win   => Win,
                             Calls => (Key_Press    => Quit_Handler'Unrestricted_Access,
                                       Exposed      => Expose_Handler'Unrestricted_Access,
                                       Resized      => Resize_Handler'Unrestricted_Access,
                                       Close_Window => Quit_Handler'Unrestricted_Access,
                                       others       => No_Callback),
                             FPS   => Framerate,
                             Frame => New_Frame'Unrestricted_Access);
   end;

exception
   when Program_Exit =>
      null;  -- just exit this block, which terminates the app

end Spinner;

Add a little color to our square to improve visual appeal


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

with Security.Permissions;

with ASF.Applications;

with AWA.Modules;
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Users.Services;
with AWA.Users.Models;
with AWA.Events;
private with Ada.Strings.Unbounded;

--  == Events ==
--  The *workspaces* module provides several events that are posted when some action are performed.
--
--  === invite-user ===
--  This event is posted when an invitation is created for a user.  The event can be used to
--  send the associated invitation email to the invitee.  The event contains the following
--  attributes:
--
--  key
--  email
--  name
--  message
--  inviter
--
--  === accept-invitation ===
--  This event is posted when an invitation is accepted by a user.
package AWA.Workspaces.Modules is

   subtype Permission_Index_Array is Security.Permissions.Permission_Index_Array;

   Not_Found : exception;

   --  The name under which the module is registered.
   NAME : constant String := "workspaces";

   --  The configuration parameter that defines the list of permissions to grant
   --  to a user when his workspace is created.
   PARAM_PERMISSIONS_LIST : constant String := "permissions_list";

   --  Permission to create a workspace.
   package ACL_Create_Workspace is new Security.Permissions.Definition ("workspace-create");

   package Invite_User_Event is new AWA.Events.Definition (Name => "invite-user");
   package Accept_Invitation_Event is new AWA.Events.Definition (Name => "accept-invitation");

   --  ------------------------------
   --  Module workspaces
   --  ------------------------------
   type Workspace_Module is new AWA.Modules.Module with private;
   type Workspace_Module_Access is access all Workspace_Module'Class;

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

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Workspace_Module;
                        Props  : in ASF.Applications.Config);

   --  Get the list of permissions for the workspace owner.
   function Get_Owner_Permissions (Manager : in Workspace_Module) return Permission_Index_Array;

   --  Get the workspace module.
   function Get_Workspace_Module return Workspace_Module_Access;

   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref);

   --  Load the invitation from the access key and verify that the key is still valid.
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class;
                              Inviter    : in out AWA.Users.Models.User_Ref);

   --  Accept the invitation identified by the access key.
   procedure Accept_Invitation (Module     : in Workspace_Module;
                                Key        : in String);

   --  Send the invitation to the user.
   procedure Send_Invitation (Module : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class);

   --  Delete the member from the workspace.  Remove the invitation if there is one.
   procedure Delete_Member (Module       : in Workspace_Module;
                            Member_Id    : in ADO.Identifier);

   --  Add a list of permissions for all the users of the workspace that have the appropriate
   --  role.  Workspace members will be able to access the given database entity for the
   --  specified list of permissions.
   procedure Add_Permission (Session    : in out ADO.Sessions.Master_Session;
                             User       : in ADO.Identifier;
                             Entity     : in ADO.Objects.Object_Ref'Class;
                             Workspace  : in ADO.Identifier;
                             List       : in Security.Permissions.Permission_Index_Array);

private

   type Workspace_Module is new AWA.Modules.Module with record
      User_Manager : AWA.Users.Services.User_Service_Access;

      --  The list of permissions to grant to a user who creates the workspace.
      Owner_Permissions : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end AWA.Workspaces.Modules;

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

with Security.Permissions;

with ASF.Applications;

with AWA.Modules;
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Users.Services;
with AWA.Users.Models;
with AWA.Events;
private with Ada.Strings.Unbounded;

--  == Events ==
--  The *workspaces* module provides several events that are posted when some action are performed.
--
--  === invite-user ===
--  This event is posted when an invitation is created for a user.  The event can be used to
--  send the associated invitation email to the invitee.  The event contains the following
--  attributes:
--
--  key
--  email
--  name
--  message
--  inviter
--
--  === accept-invitation ===
--  This event is posted when an invitation is accepted by a user.
package AWA.Workspaces.Modules is

   subtype Permission_Index_Array is Security.Permissions.Permission_Index_Array;

   Not_Found : exception;

   --  The name under which the module is registered.
   NAME : constant String := "workspaces";

   --  The configuration parameter that defines the list of permissions to grant
   --  to a user when his workspace is created.
   PARAM_PERMISSIONS_LIST : constant String := "permissions_list";

   --  Permission to create a workspace.
   package ACL_Create_Workspace is new Security.Permissions.Definition ("workspace-create");

   package Invite_User_Event is new AWA.Events.Definition (Name => "invite-user");
   package Accept_Invitation_Event is new AWA.Events.Definition (Name => "accept-invitation");

   --  ------------------------------
   --  Module workspaces
   --  ------------------------------
   type Workspace_Module is new AWA.Modules.Module with private;
   type Workspace_Module_Access is access all Workspace_Module'Class;

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

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Workspace_Module;
                        Props  : in ASF.Applications.Config);

   --  Get the list of permissions for the workspace owner.
   function Get_Owner_Permissions (Manager : in Workspace_Module) return Permission_Index_Array;

   --  Get the workspace module.
   function Get_Workspace_Module return Workspace_Module_Access;

   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref);

   --  Create a workspace for the user.
   procedure Create_Workspace (Module    : in Workspace_Module;
                               Workspace : out AWA.Workspaces.Models.Workspace_Ref);

   --  Load the invitation from the access key and verify that the key is still valid.
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class;
                              Inviter    : in out AWA.Users.Models.User_Ref);

   --  Accept the invitation identified by the access key.
   procedure Accept_Invitation (Module     : in Workspace_Module;
                                Key        : in String);

   --  Send the invitation to the user.
   procedure Send_Invitation (Module : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class);

   --  Delete the member from the workspace.  Remove the invitation if there is one.
   procedure Delete_Member (Module       : in Workspace_Module;
                            Member_Id    : in ADO.Identifier);

   --  Add a list of permissions for all the users of the workspace that have the appropriate
   --  role.  Workspace members will be able to access the given database entity for the
   --  specified list of permissions.
   procedure Add_Permission (Session    : in out ADO.Sessions.Master_Session;
                             User       : in ADO.Identifier;
                             Entity     : in ADO.Objects.Object_Ref'Class;
                             Workspace  : in ADO.Identifier;
                             List       : in Security.Permissions.Permission_Index_Array);

private

   type Workspace_Module is new AWA.Modules.Module with record
      User_Manager : AWA.Users.Services.User_Service_Access;

      --  The list of permissions to grant to a user who creates the workspace.
      Owner_Permissions : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end AWA.Workspaces.Modules;

Declare the Create_Workspace procedure

Declare the Create_Workspace procedure